From fd51af810f355e80199df5bdb984266dd55beffa Mon Sep 17 00:00:00 2001 From: Rudy Ges Date: Tue, 30 Jan 2024 11:53:42 +0100 Subject: [PATCH 01/51] [std] a bit of safety here --- std/haxe/Log.hx | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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; From eee3274e186a6b98222e37c3c56cee99a7bc0094 Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Tue, 30 Jan 2024 12:03:03 +0100 Subject: [PATCH 02/51] Clean up TAnon field handling (#11518) * [display] clean up TAnon display field handling see #11515 * add test --- src/context/display/displayFields.ml | 83 +++++++++++++-------------- tests/display/src/cases/Issue11515.hx | 27 +++++++++ 2 files changed, 67 insertions(+), 43 deletions(-) create mode 100644 tests/display/src/cases/Issue11515.hx diff --git a/src/context/display/displayFields.ml b/src/context/display/displayFields.ml index fabfb77d091..8540e92fb99 100644 --- a/src/context/display/displayFields.ml +++ b/src/context/display/displayFields.ml @@ -250,54 +250,51 @@ let collect ctx e_ast e dk with_type p = end | _ -> items in - (* Anon own fields *) - let fields = match !(an.a_status) with - | ClassStatics c -> c.cl_statics - | _ -> an.a_fields + let iter_fields origin fields f_allow f_make = + let items = PMap.fold (fun cf acc -> + if is_new_item acc cf.cf_name && f_allow cf then begin + let ct = CompletionType.from_type (get_import_status ctx) ~values:(get_value_meta cf.cf_meta) cf.cf_type in + PMap.add cf.cf_name (f_make (CompletionClassField.make cf CFSMember origin true) (cf.cf_type,ct)) acc + end else + acc + ) fields items in + items in - PMap.foldi (fun name cf acc -> - if is_new_item acc name then begin - let allow_static_abstract_access c cf = + begin match !(an.a_status) with + | ClassStatics ({cl_kind = KAbstractImpl a} as c) -> + Display.merge_core_doc ctx (TClassDecl c); + let f_allow cf = should_access c cf false && (not (has_class_field_flag cf CfImpl) || has_class_field_flag cf CfEnum) in - let ct = CompletionType.from_type (get_import_status ctx) ~values:(get_value_meta cf.cf_meta) cf.cf_type in - let add origin make_field = - PMap.add name (make_field (CompletionClassField.make cf CFSMember origin true) (cf.cf_type,ct)) acc + let f_make ccf = + if has_class_field_flag ccf.CompletionClassField.field CfEnum then + make_ci_enum_abstract_field a ccf + else + make_ci_class_field ccf in - match !(an.a_status) with - | ClassStatics ({cl_kind = KAbstractImpl a} as c) -> - if allow_static_abstract_access c cf then - let make = if has_class_field_flag cf CfEnum then - (make_ci_enum_abstract_field a) - else - make_ci_class_field - in - add (Self (TAbstractDecl a)) make - else - acc; - | ClassStatics c -> - Display.merge_core_doc ctx (TClassDecl c); - if should_access c cf true then add (Self (TClassDecl c)) make_ci_class_field else acc; - | EnumStatics en -> - let ef = PMap.find name en.e_constrs in - PMap.add name (make_ci_enum_field (CompletionEnumField.make ef (Self (TEnumDecl en)) true) (cf.cf_type,ct)) acc - | AbstractStatics a -> - Display.merge_core_doc ctx (TAbstractDecl a); - let check = match a.a_impl with - | None -> true - | Some c -> allow_static_abstract_access c cf - in - if check then add (Self (TAbstractDecl a)) make_ci_class_field else acc; - | _ -> - let origin = match t with - | TType(td,_) -> Self (TTypeDecl td) - | _ -> AnonymousStructure an - in - add origin make_ci_class_field; - end else - acc - ) fields items + iter_fields (Self (TClassDecl c)) c.cl_statics f_allow f_make + | ClassStatics c -> + Display.merge_core_doc ctx (TClassDecl c); + let f_allow cf = should_access c cf true in + iter_fields (Self (TClassDecl c)) c.cl_statics f_allow make_ci_class_field + | AbstractStatics ({a_impl = Some c} as a) -> + Display.merge_core_doc ctx (TAbstractDecl a); + let f_allow cf = should_access c cf true in + iter_fields (Self (TAbstractDecl a)) c.cl_statics f_allow make_ci_class_field + | EnumStatics en -> + PMap.fold (fun ef acc -> + let ct = CompletionType.from_type (get_import_status ctx) ~values:(get_value_meta ef.ef_meta) ef.ef_type in + let cef = CompletionEnumField.make ef (Self (TEnumDecl en)) true in + PMap.add ef.ef_name (make_ci_enum_field cef (ef.ef_type,ct)) acc + ) en.e_constrs items + | _ -> + let origin = match t with + | TType(td,_) -> Self (TTypeDecl td) + | _ -> AnonymousStructure an + in + iter_fields origin an.a_fields (fun _ -> true) make_ci_class_field + end | TFun (args,ret) -> (* A function has no field except the magic .bind one. *) if is_new_item items "bind" then begin 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")); + } +} From c1697d4e7ded292c798c740ce6840bfa249829aa Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Tue, 30 Jan 2024 12:09:59 +0100 Subject: [PATCH 03/51] Rename EvalStackTrace.ml to evalStackTrace.ml --- src/macro/eval/{EvalStackTrace.ml => evalStackTrace.ml} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename src/macro/eval/{EvalStackTrace.ml => evalStackTrace.ml} (100%) 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 From e43e18ff8728d4e13beda3f2928a984152528c31 Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Tue, 30 Jan 2024 15:10:42 +0100 Subject: [PATCH 04/51] [hxb] don't write MFake deps because we cannot load them like that --- src/compiler/hxb/hxbWriter.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/compiler/hxb/hxbWriter.ml b/src/compiler/hxb/hxbWriter.ml index 9e77b5b9e4b..7f6e4aa12d4 100644 --- a/src/compiler/hxb/hxbWriter.ml +++ b/src/compiler/hxb/hxbWriter.ml @@ -2237,8 +2237,8 @@ module HxbWriter = struct let deps = DynArray.create () in PMap.iter (fun _ mdep -> match mdep.md_kind with - | MCode | MExtern | MFake when mdep.md_sign = m.m_extra.m_sign -> - DynArray.add deps mdep.md_path; + | MCode | MExtern when mdep.md_sign = m.m_extra.m_sign -> + DynArray.add deps mdep.md_path; | _ -> () ) m.m_extra.m_deps; From 050acbe657bf233d74eb521e5f3f0e1d210fd4b9 Mon Sep 17 00:00:00 2001 From: Yaroslav Sivakov Date: Tue, 30 Jan 2024 17:33:46 +0300 Subject: [PATCH 05/51] Update haxe.macro.Printer.hx (#11522) Old version generate code: ``` class MyClass ``` Compiling that code produce error "unexpected >". New version produce ``` class MyClass ``` which compile OK --- std/haxe/macro/Printer.hx | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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) From a2c3714582edebe09b56cb815ee517dcab04f9de Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Tue, 30 Jan 2024 17:56:57 +0100 Subject: [PATCH 06/51] [java] use BufferedInputStream in FileInput closes #11487 --- std/java/_std/sys/io/FileInput.hx | 26 ++++++++------------------ 1 file changed, 8 insertions(+), 18 deletions(-) diff --git a/std/java/_std/sys/io/FileInput.hx b/std/java/_std/sys/io/FileInput.hx index 6e4a080c95a..70d435288cd 100644 --- a/std/java/_std/sys/io/FileInput.hx +++ b/std/java/_std/sys/io/FileInput.hx @@ -22,6 +22,8 @@ package sys.io; +import java.io.FileInputStream; +import java.io.BufferedInputStream; import haxe.Int64; import haxe.io.Bytes; import haxe.io.Eof; @@ -31,10 +33,12 @@ import java.io.IOException; class FileInput extends Input { var f:java.io.RandomAccessFile; + var b:BufferedInputStream; var _eof:Bool; function new(f) { this.f = f; + b = new BufferedInputStream(new FileInputStream(f.getFD())); this._eof = false; } @@ -46,29 +50,16 @@ class FileInput extends Input { } override public function readByte():Int { - try { - return f.readUnsignedByte(); - } catch (e:EOFException) { - + var i = b.read(); + if (i == -1) { _eof = true; throw new Eof(); - } catch (e:IOException) { - throw haxe.io.Error.Custom(e); } + return i; } override public function readBytes(s:Bytes, pos:Int, len:Int):Int { - var ret = 0; - try { - ret = f.read(s.getData(), pos, len); - } catch (e:EOFException) { - - _eof = true; - throw new Eof(); - } catch (e:IOException) { - throw haxe.io.Error.Custom(e); - } - + var ret = b.read(s.getData(), pos, len); if (ret == -1) { _eof = true; throw new Eof(); @@ -89,7 +80,6 @@ class FileInput extends Input { f.seek(haxe.Int64.add(f.length(), cast p)); } } catch (e:EOFException) { - _eof = true; throw new Eof(); } catch (e:IOException) { From a79f913737ece327edafd0949d8223693fca6102 Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Tue, 30 Jan 2024 20:29:51 +0100 Subject: [PATCH 07/51] Revert "[java] use BufferedInputStream in FileInput" This reverts commit a2c3714582edebe09b56cb815ee517dcab04f9de. --- std/java/_std/sys/io/FileInput.hx | 26 ++++++++++++++++++-------- 1 file changed, 18 insertions(+), 8 deletions(-) diff --git a/std/java/_std/sys/io/FileInput.hx b/std/java/_std/sys/io/FileInput.hx index 70d435288cd..6e4a080c95a 100644 --- a/std/java/_std/sys/io/FileInput.hx +++ b/std/java/_std/sys/io/FileInput.hx @@ -22,8 +22,6 @@ package sys.io; -import java.io.FileInputStream; -import java.io.BufferedInputStream; import haxe.Int64; import haxe.io.Bytes; import haxe.io.Eof; @@ -33,12 +31,10 @@ import java.io.IOException; class FileInput extends Input { var f:java.io.RandomAccessFile; - var b:BufferedInputStream; var _eof:Bool; function new(f) { this.f = f; - b = new BufferedInputStream(new FileInputStream(f.getFD())); this._eof = false; } @@ -50,16 +46,29 @@ class FileInput extends Input { } override public function readByte():Int { - var i = b.read(); - if (i == -1) { + try { + return f.readUnsignedByte(); + } catch (e:EOFException) { + _eof = true; throw new Eof(); + } catch (e:IOException) { + throw haxe.io.Error.Custom(e); } - return i; } override public function readBytes(s:Bytes, pos:Int, len:Int):Int { - var ret = b.read(s.getData(), pos, len); + var ret = 0; + try { + ret = f.read(s.getData(), pos, len); + } catch (e:EOFException) { + + _eof = true; + throw new Eof(); + } catch (e:IOException) { + throw haxe.io.Error.Custom(e); + } + if (ret == -1) { _eof = true; throw new Eof(); @@ -80,6 +89,7 @@ class FileInput extends Input { f.seek(haxe.Int64.add(f.length(), cast p)); } } catch (e:EOFException) { + _eof = true; throw new Eof(); } catch (e:IOException) { From b0ec8625a207656a58170295e4d9afa1bb2f3413 Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Tue, 30 Jan 2024 21:43:25 +0100 Subject: [PATCH 08/51] Set --run args only when we're actually running (#11524) * set --run args only when we're actually running see #11087 * add test * add another test --- src/compiler/compilationContext.ml | 1 + src/compiler/compiler.ml | 3 ++- src/compiler/generate.ml | 13 ++++++++++--- src/context/common.ml | 4 +--- src/macro/eval/evalStdLib.ml | 2 +- tests/misc/projects/Issue11087/Main.hx | 9 +++++++++ tests/misc/projects/Issue11087/compile-interp.hxml | 2 ++ .../projects/Issue11087/compile-interp.hxml.stdout | 2 ++ tests/misc/projects/Issue11087/compile.hxml | 2 ++ tests/misc/projects/Issue11087/compile.hxml.stdout | 2 ++ 10 files changed, 32 insertions(+), 8 deletions(-) create mode 100644 tests/misc/projects/Issue11087/Main.hx create mode 100644 tests/misc/projects/Issue11087/compile-interp.hxml create mode 100644 tests/misc/projects/Issue11087/compile-interp.hxml.stdout create mode 100644 tests/misc/projects/Issue11087/compile.hxml create mode 100644 tests/misc/projects/Issue11087/compile.hxml.stdout diff --git a/src/compiler/compilationContext.ml b/src/compiler/compilationContext.ml index b2df6431349..f6697e4e136 100644 --- a/src/compiler/compilationContext.ml +++ b/src/compiler/compilationContext.ml @@ -54,6 +54,7 @@ and compilation_context = { mutable has_next : bool; mutable has_error : bool; comm : communication; + mutable runtime_args : string list; } type compilation_callbacks = { diff --git a/src/compiler/compiler.ml b/src/compiler/compiler.ml index 3654a6e0a5d..26c9fb7b9c5 100644 --- a/src/compiler/compiler.ml +++ b/src/compiler/compiler.ml @@ -509,6 +509,7 @@ let create_context comm cs compilation_step params = { has_next = false; has_error = false; comm = comm; + runtime_args = []; } module HighLevel = struct @@ -614,7 +615,7 @@ module HighLevel = struct | "--run" :: cl :: args -> let acc = cl :: "-x" :: acc in let ctx = create_context (List.rev acc) in - ctx.com.sys_args <- args; + ctx.runtime_args <- args; [],Some ctx | ("-L" | "--library" | "-lib") :: name :: args -> let libs,args = find_subsequent_libs [name] args in diff --git a/src/compiler/generate.ml b/src/compiler/generate.ml index d3671463146..8066f4f4e57 100644 --- a/src/compiler/generate.ml +++ b/src/compiler/generate.ml @@ -121,9 +121,16 @@ let generate ctx tctx ext actx = | Java when not actx.jvm_flag -> Path.mkdir_from_path (com.file ^ "/.") | _ -> Path.mkdir_from_path com.file end; - if actx.interp then - Std.finally (Timer.timer ["interp"]) MacroContext.interpret tctx - else begin + if actx.interp then begin + let timer = Timer.timer ["interp"] in + let old = tctx.com.args in + tctx.com.args <- ctx.runtime_args; + let restore () = + tctx.com.args <- old; + timer () + in + Std.finally restore MacroContext.interpret tctx + end else begin let generate,name = match com.platform with | Flash -> let header = try diff --git a/src/context/common.ml b/src/context/common.ml index 59359f5d01a..2fec5ff4a2e 100644 --- a/src/context/common.ml +++ b/src/context/common.ml @@ -354,8 +354,7 @@ type context = { mutable json_out : json_api option; (* config *) version : int; - args : string list; - mutable sys_args : string list; + mutable args : string list; mutable display : DisplayTypes.DisplayMode.settings; mutable debug : bool; mutable verbose : bool; @@ -810,7 +809,6 @@ let create compilation_step cs version args display_mode = display_module_has_macro_defines = false; module_diagnostics = []; }; - sys_args = args; debug = false; display = display_mode; verbose = false; diff --git a/src/macro/eval/evalStdLib.ml b/src/macro/eval/evalStdLib.ml index 9212e689728..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 -> 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 From 9e7a820a587fb08d3ad385d4a329f80e3977c81e Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Tue, 30 Jan 2024 22:38:45 +0100 Subject: [PATCH 09/51] [typer] don't hide abstract type when resolving through @:forward closes #11526 --- src/typing/fields.ml | 2 +- .../src/TestInlineConstructors.hx | 19 +++++++++++++++++++ 2 files changed, 20 insertions(+), 1 deletion(-) diff --git a/src/typing/fields.ml b/src/typing/fields.ml index 212430d037b..ffd3a75aae8 100644 --- a/src/typing/fields.ml +++ b/src/typing/fields.ml @@ -270,7 +270,7 @@ 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) + f (mk (TCast(e,None)) t e.epos) (follow_without_type t) in let type_field_by_e f e = f e (follow_without_type e.etype) 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]; + } } From e2e359be130917f06802976532e6af5ab25aca0a Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Wed, 31 Jan 2024 07:53:44 +0100 Subject: [PATCH 10/51] add @:forward.accessOnAbstract and use it for cs.PointerAccess --- src-json/meta.json | 6 ++++++ src/typing/fields.ml | 17 ++++++++++++++--- std/cs/Pointer.hx | 4 +++- 3 files changed, 23 insertions(+), 4 deletions(-) diff --git a/src-json/meta.json b/src-json/meta.json index 9df0fb365e6..ddc3f8f9b03 100644 --- a/src-json/meta.json +++ b/src-json/meta.json @@ -395,6 +395,12 @@ "targets": ["TAbstract"], "links": ["https://haxe.org/manual/types-abstract-forward.html"] }, + { + "name": "ForwardAccessOnAbstract", + "metadata": ":forward.accessOnAbstract", + "doc": "Generates @:forward field access on the abstract itself instead of the underlying type.", + "targets": ["TAbstract"] + }, { "name": "ForwardNew", "metadata": ":forward.new", diff --git a/src/typing/fields.ml b/src/typing/fields.ml index ffd3a75aae8..6df1870c565 100644 --- a/src/typing/fields.ml +++ b/src/typing/fields.ml @@ -270,7 +270,7 @@ 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 (mk (TCast(e,None)) t e.epos) (follow_without_type t) + f e (follow_without_type t) in let type_field_by_e f e = f e (follow_without_type e.etype) @@ -291,7 +291,15 @@ let type_field cfg ctx e i p mode (with_type : WithType.t) = type_field_by_forward f Meta.ForwardStatics a in let type_field_by_forward_member f e a tl = - let f () = type_field_by_et f e (Abstract.get_underlying_type ~return_first:true a tl) in + let f () = + let t = Abstract.get_underlying_type ~return_first:true a tl in + let e = if Meta.has Meta.ForwardAccessOnAbstract a.a_meta then + e + else + mk (TCast(e,None)) t e.epos + in + type_field_by_et f e t + in type_field_by_forward f Meta.Forward a in let type_field_by_typedef f e td tl = @@ -374,7 +382,10 @@ let type_field cfg ctx e i p mode (with_type : WithType.t) = field_access f FHAnon ) | CTypes tl -> - type_field_by_list (fun (t,_) -> type_field_by_et type_field_by_type e t) tl + type_field_by_list (fun (t,_) -> + let e = mk (TCast(e,None)) t e.epos in + 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; diff --git a/std/cs/Pointer.hx b/std/cs/Pointer.hx index 5d18c665369..4026af75a5e 100644 --- a/std/cs/Pointer.hx +++ b/std/cs/Pointer.hx @@ -129,5 +129,7 @@ import cs.StdTypes.Int64; @:arrayAccess public static function setp(p:Pointer, at:Int64, val:T):T; } -@:forward abstract PointerAccess(T) {} +@:forward +@:forward.accessOnAbstract +abstract PointerAccess(T) {} #end From 9d1f947b1e81e50882473cc867fd7372b32d1988 Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Wed, 31 Jan 2024 09:24:45 +0100 Subject: [PATCH 11/51] output binary cache memory --- src/compiler/compilationCache.ml | 2 +- src/context/memory.ml | 3 +++ std/haxe/display/Server.hx | 3 +++ 3 files changed, 7 insertions(+), 1 deletion(-) diff --git a/src/compiler/compilationCache.ml b/src/compiler/compilationCache.ml index 9385453facc..fef5056b25b 100644 --- a/src/compiler/compilationCache.ml +++ b/src/compiler/compilationCache.ml @@ -108,7 +108,7 @@ class context_cache (index : int) (sign : Digest.t) = object(self) (* Pointers for memory inspection. *) method get_pointers : unit array = - [|Obj.magic files;Obj.magic modules|] + [|Obj.magic files;Obj.magic modules;Obj.magic binary_cache|] end let create_directory path mtime = { diff --git a/src/context/memory.ml b/src/context/memory.ml index 6299d454cba..c0613b9db62 100644 --- a/src/context/memory.ml +++ b/src/context/memory.ml @@ -169,6 +169,9 @@ let get_memory_json (cs : CompilationCache.t) mreq = "size",jint (mem_size cache_mem.(1)); "list",jarray l; ]; + "binaryCache",jobject [ + "size",jint (mem_size cache_mem.(2)); + ]; ] | MModule(sign,path) -> let cc = cs#get_context sign in diff --git a/std/haxe/display/Server.hx b/std/haxe/display/Server.hx index b7792084a15..0c20e60baf1 100644 --- a/std/haxe/display/Server.hx +++ b/std/haxe/display/Server.hx @@ -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<{ From c5f913ca14e0ee424119045cb835c80d79ea9603 Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Wed, 31 Jan 2024 11:40:44 +0100 Subject: [PATCH 12/51] clean up ctx.type_params initialization closes #11528 --- src/typing/typeloadFields.ml | 10 ++++------ tests/misc/projects/Issue11528/Main.hx | 9 +++++++++ tests/misc/projects/Issue11528/compile-fail.hxml | 1 + .../misc/projects/Issue11528/compile-fail.hxml.stderr | 1 + 4 files changed, 15 insertions(+), 6 deletions(-) create mode 100644 tests/misc/projects/Issue11528/Main.hx create mode 100644 tests/misc/projects/Issue11528/compile-fail.hxml create mode 100644 tests/misc/projects/Issue11528/compile-fail.hxml.stderr diff --git a/src/typing/typeloadFields.ml b/src/typing/typeloadFields.ml index 36ffbdbf9fa..8c85692ee7b 100644 --- a/src/typing/typeloadFields.ml +++ b/src/typing/typeloadFields.ml @@ -557,7 +557,7 @@ let create_typer_context_for_class ctx cctx p = let ctx = { ctx with curclass = c; - type_params = c.cl_params; + type_params = (match c.cl_kind with KAbstractImpl a -> a.a_params | _ -> c.cl_params); pass = PBuildClass; tthis = (match cctx.abstract with | Some a -> @@ -636,7 +636,9 @@ let create_typer_context_for_field ctx cctx fctx cff = monomorphs = { perfunction = []; }; + type_params = if fctx.is_static && not fctx.is_abstract_member then [] else ctx.type_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 @@ -1356,7 +1358,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 = { @@ -1632,10 +1634,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) -> 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 From b3d3a2ff91f3dba25a35961f9dab67be3ade4b32 Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Wed, 31 Jan 2024 12:55:45 +0100 Subject: [PATCH 13/51] Revert @:forward.accessOnAbstract, hack instead see #11527 --- src-json/meta.json | 6 ------ src/typing/fields.ml | 21 ++++++++------------- std/cs/Pointer.hx | 4 +--- 3 files changed, 9 insertions(+), 22 deletions(-) diff --git a/src-json/meta.json b/src-json/meta.json index ddc3f8f9b03..9df0fb365e6 100644 --- a/src-json/meta.json +++ b/src-json/meta.json @@ -395,12 +395,6 @@ "targets": ["TAbstract"], "links": ["https://haxe.org/manual/types-abstract-forward.html"] }, - { - "name": "ForwardAccessOnAbstract", - "metadata": ":forward.accessOnAbstract", - "doc": "Generates @:forward field access on the abstract itself instead of the underlying type.", - "targets": ["TAbstract"] - }, { "name": "ForwardNew", "metadata": ":forward.new", diff --git a/src/typing/fields.ml b/src/typing/fields.ml index 6df1870c565..b1c29238caf 100644 --- a/src/typing/fields.ml +++ b/src/typing/fields.ml @@ -270,6 +270,12 @@ 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 = + 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 = @@ -291,15 +297,7 @@ let type_field cfg ctx e i p mode (with_type : WithType.t) = type_field_by_forward f Meta.ForwardStatics a in let type_field_by_forward_member f e a tl = - let f () = - let t = Abstract.get_underlying_type ~return_first:true a tl in - let e = if Meta.has Meta.ForwardAccessOnAbstract a.a_meta then - e - else - mk (TCast(e,None)) t e.epos - in - type_field_by_et f e t - in + let f () = type_field_by_et f e (Abstract.get_underlying_type ~return_first:true a tl) in type_field_by_forward f Meta.Forward a in let type_field_by_typedef f e td tl = @@ -382,10 +380,7 @@ let type_field cfg ctx e i p mode (with_type : WithType.t) = field_access f FHAnon ) | CTypes tl -> - type_field_by_list (fun (t,_) -> - let e = mk (TCast(e,None)) t e.epos in - type_field_by_et type_field_by_type e t - ) 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; diff --git a/std/cs/Pointer.hx b/std/cs/Pointer.hx index 4026af75a5e..5d18c665369 100644 --- a/std/cs/Pointer.hx +++ b/std/cs/Pointer.hx @@ -129,7 +129,5 @@ import cs.StdTypes.Int64; @:arrayAccess public static function setp(p:Pointer, at:Int64, val:T):T; } -@:forward -@:forward.accessOnAbstract -abstract PointerAccess(T) {} +@:forward abstract PointerAccess(T) {} #end From 706f607ed9c68bce3f107ae14a2d3684e964418f Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Wed, 31 Jan 2024 14:38:41 +0100 Subject: [PATCH 14/51] dodge c# static type param problem see #11527 --- src/typing/typeloadFields.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/typing/typeloadFields.ml b/src/typing/typeloadFields.ml index 8c85692ee7b..80a2b395657 100644 --- a/src/typing/typeloadFields.ml +++ b/src/typing/typeloadFields.ml @@ -636,7 +636,7 @@ let create_typer_context_for_field ctx cctx fctx cff = monomorphs = { perfunction = []; }; - type_params = if fctx.is_static && not fctx.is_abstract_member then [] else ctx.type_params; + type_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 c = cctx.tclass in From ca89e04303682de586d15eef0e6f8c756e4eb933 Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Wed, 31 Jan 2024 19:48:26 +0100 Subject: [PATCH 15/51] adapt to mbedtls HL changes --- extra/BUILDING.md | 2 +- tests/runci/targets/Hl.hx | 1 - 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/extra/BUILDING.md b/extra/BUILDING.md index dc22b45c1c9..a5c7e986f04 100644 --- a/extra/BUILDING.md +++ b/extra/BUILDING.md @@ -36,7 +36,7 @@ You need to install some native libraries as well as some OCaml libraries. To install the native libraries, use the appropriate system package manager. * Mac OS X - * Use [Homebrew](https://brew.sh/), `brew install zlib pcre2 mbedtls@2`. + * Use [Homebrew](https://brew.sh/), `brew install zlib pcre2 mbedtls`. * Debian / Ubuntu * `sudo apt install libpcre2-dev zlib1g-dev libmbedtls-dev`. * Windows (Cygwin) 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 } From 3280f2f72ae0cfac9eb741ef83e0c8d82e654e4d Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Thu, 1 Feb 2024 07:13:55 +0100 Subject: [PATCH 16/51] Hxb writer config (#11507) * start on writer config * functorize * add Compiler.setHxbWriterConfiguration * rename * add Compiler.getHxbWriterConfiguration * document * substitute $target when we actually need it * fix my favorite test * file * add generateDocumentation * don't forget the writer * (temporarily?) read until EOT immediately see #11512 --- src/compiler/args.ml | 6 +- src/compiler/compilationCache.ml | 4 +- src/compiler/compiler.ml | 12 +- src/compiler/generate.ml | 43 ++++--- src/compiler/hxb/hxbWriter.ml | 31 +++-- src/compiler/hxb/hxbWriterConfig.ml | 119 ++++++++++++++++++ src/context/common.ml | 2 + src/context/commonCache.ml | 8 +- src/core/data/dataReaderApi.ml | 17 +++ src/core/data/dataWriterApi.ml | 15 +++ src/core/data/jsonDataApi.ml | 48 +++++++ src/macro/eval/evalDataApi.ml | 61 +++++++++ src/macro/macroApi.ml | 9 ++ src/typing/macroContext.ml | 26 ++++ src/typing/typeloadModule.ml | 9 +- std/haxe/hxb/WriterConfig.hx | 51 ++++++++ std/haxe/macro/Compiler.hx | 35 ++++++ .../user-defined-define-json-fail.hxml.stderr | 2 +- .../user-defined-meta-json-fail.hxml.stderr | 2 +- ...-defined-meta-json-indent-fail.hxml.stderr | 2 +- ...-defined-meta-json-pretty-fail.hxml.stderr | 4 +- tests/unit/compile-hxb-jvm-roundtrip.hxml | 4 +- tests/unit/hxb-config/jvm.json | 10 ++ tests/unit/src/unit/TestMain.hx | 4 +- tests/unit/src/unit/TestMainNow.hx | 9 ++ 25 files changed, 481 insertions(+), 52 deletions(-) create mode 100644 src/compiler/hxb/hxbWriterConfig.ml create mode 100644 src/core/data/dataReaderApi.ml create mode 100644 src/core/data/dataWriterApi.ml create mode 100644 src/core/data/jsonDataApi.ml create mode 100644 src/macro/eval/evalDataApi.ml create mode 100644 std/haxe/hxb/WriterConfig.hx create mode 100644 tests/unit/hxb-config/jvm.json create mode 100644 tests/unit/src/unit/TestMainNow.hx diff --git a/src/compiler/args.ml b/src/compiler/args.ml index 1f7d09b0d00..45edbf9008f 100644 --- a/src/compiler/args.ml +++ b/src/compiler/args.ml @@ -278,9 +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 dir -> - actx.hxb_out <- Some dir; - ),"", "generate haxe binary representation in target directory"); + ("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 fef5056b25b..b7c8ea854cc 100644 --- a/src/compiler/compilationCache.ml +++ b/src/compiler/compilationCache.ml @@ -69,12 +69,12 @@ class context_cache (index : int) (sign : Digest.t) = object(self) 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 warn anon_identification hxb_writer_stats path m = + method cache_module config warn anon_identification hxb_writer_stats path m = match m.m_extra.m_kind with | MImport -> Hashtbl.add modules m.m_path m | _ -> - let writer = HxbWriter.create warn anon_identification hxb_writer_stats in + let writer = HxbWriter.create config warn anon_identification hxb_writer_stats in HxbWriter.write_module writer m; let chunks = HxbWriter.get_chunks writer in Hashtbl.replace binary_cache path { diff --git a/src/compiler/compiler.ml b/src/compiler/compiler.ml index 26c9fb7b9c5..93ee2464f6b 100644 --- a/src/compiler/compiler.ml +++ b/src/compiler/compiler.ml @@ -369,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; @@ -382,7 +388,11 @@ let compile ctx actx callbacks = let is_compilation = is_compilation com in com.callbacks#add_after_save (fun () -> callbacks.after_save ctx; - if is_compilation then Generate.check_hxb_output ctx actx; + 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) diff --git a/src/compiler/generate.ml b/src/compiler/generate.ml index 8066f4f4e57..e12e22e372b 100644 --- a/src/compiler/generate.ml +++ b/src/compiler/generate.ml @@ -21,7 +21,7 @@ let check_auxiliary_output com actx = Genjson.generate com.types file end -let export_hxb com cc platform zip m = +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 @@ -42,7 +42,7 @@ let export_hxb com cc platform zip m = 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 warn anon_identification com.hxb_writer_stats in + let writer = HxbWriter.create config warn anon_identification com.hxb_writer_stats in HxbWriter.write_module writer m; let out = IO.output_string () in HxbWriter.export writer out; @@ -51,37 +51,46 @@ let export_hxb com cc platform zip m = | _ -> () -let check_hxb_output ctx actx = +let check_hxb_output ctx config = + let open HxbWriterConfig in let com = ctx.com in - let try_write path = + 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 = + 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 - Std.finally t (export_hxb com cc target zip) m + 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 () -> - export com; - Option.may export (com.get_macros()); + 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 - begin match actx.hxb_out with - | None -> - () - | Some path -> - try - try_write path - with Sys_error s -> - error ctx (Printf.sprintf "Could not write to %s: %s" path s) null_pos - end + 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] -> diff --git a/src/compiler/hxb/hxbWriter.ml b/src/compiler/hxb/hxbWriter.ml index 7f6e4aa12d4..39cde88c266 100644 --- a/src/compiler/hxb/hxbWriter.ml +++ b/src/compiler/hxb/hxbWriter.ml @@ -511,6 +511,7 @@ let create_field_writer_context pos_writer = { } type hxb_writer = { + config : HxbWriterConfig.writer_target_config; warn : Warning.warning -> string -> Globals.pos -> unit; anon_id : Type.t Tanon_identification.tanon_identification; stats : hxb_writer_stats; @@ -601,13 +602,18 @@ module HxbWriter = struct Chunk.write_string writer.chunk mname; Chunk.write_string writer.chunk tname - let write_documentation writer (doc : doc_block) = - 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) - ) + 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; @@ -753,7 +759,7 @@ module HxbWriter = struct and write_cfield writer cff = write_placed_name writer cff.cff_name; - Chunk.write_option writer.chunk cff.cff_doc (write_documentation writer); + 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); @@ -1829,7 +1835,7 @@ module HxbWriter = struct let restore = start_temporary_chunk writer 512 in write_type_instance writer cf.cf_type; Chunk.write_uleb128 writer.chunk cf.cf_flags; - Chunk.write_option writer.chunk cf.cf_doc (write_documentation writer); + 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 @@ -1876,7 +1882,7 @@ module HxbWriter = struct let write_common_module_type writer (infos : tinfos) : unit = Chunk.write_bool writer.chunk infos.mt_private; - Chunk.write_option writer.chunk infos.mt_doc (write_documentation writer); + 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) -> @@ -2141,7 +2147,7 @@ module HxbWriter = struct 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; - Chunk.write_option writer.chunk ef.ef_doc (write_documentation writer); + maybe_write_documentation writer ef.ef_doc; write_metadata writer ef.ef_meta; close(); ); @@ -2281,9 +2287,10 @@ module HxbWriter = struct l end -let create warn anon_id stats = +let create config warn anon_id stats = let cp = StringPool.create () in { + config; warn; anon_id; stats; diff --git a/src/compiler/hxb/hxbWriterConfig.ml b/src/compiler/hxb/hxbWriterConfig.ml new file mode 100644 index 00000000000..a81d4caeec4 --- /dev/null +++ b/src/compiler/hxb/hxbWriterConfig.ml @@ -0,0 +1,119 @@ +open Globals +open Json +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/context/common.ml b/src/context/common.ml index 2fec5ff4a2e..e1e3577f8b0 100644 --- a/src/context/common.ml +++ b/src/context/common.ml @@ -421,6 +421,7 @@ type context = { memory_marker : float array; hxb_reader_stats : HxbReader.hxb_reader_stats; hxb_writer_stats : HxbWriter.hxb_writer_stats; + mutable hxb_writer_config : HxbWriterConfig.t option; } let enter_stage com stage = @@ -883,6 +884,7 @@ let create compilation_step cs version args display_mode = is_macro_context = false; hxb_reader_stats = HxbReader.create_hxb_reader_stats (); hxb_writer_stats = HxbWriter.create_hxb_writer_stats (); + hxb_writer_config = None; } in com diff --git a/src/context/commonCache.ml b/src/context/commonCache.ml index 2ad51ed2201..312d5cc723c 100644 --- a/src/context/commonCache.ml +++ b/src/context/commonCache.ml @@ -85,11 +85,17 @@ 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 let warn w s p = com.warning w com.warning_options s p in - cc#cache_module warn anon_identification com.hxb_writer_stats m.m_path m; + cc#cache_module config warn anon_identification com.hxb_writer_stats m.m_path m; in List.iter cache_module com.modules; begin match com.get_macros() with 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/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/macroApi.ml b/src/macro/macroApi.ml index bea386127d7..d7b1b8f97eb 100644 --- a/src/macro/macroApi.ml +++ b/src/macro/macroApi.ml @@ -70,6 +70,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; } @@ -2405,5 +2407,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/typing/macroContext.ml b/src/typing/macroContext.ml index 5a826098df5..8a85aa0cdb2 100644 --- a/src/typing/macroContext.ml +++ b/src/typing/macroContext.ml @@ -34,6 +34,10 @@ module Interp = struct include BuiltApi end + +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 = @@ -305,6 +309,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 = diff --git a/src/typing/typeloadModule.ml b/src/typing/typeloadModule.ml index 5c94a9fa8a1..69380e173d5 100644 --- a/src/typing/typeloadModule.ml +++ b/src/typing/typeloadModule.ml @@ -818,12 +818,9 @@ let rec load_hxb_module ctx path p = 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 MTF in - delay ctx PBuildClass (fun () -> - ignore(read EOT); - delay ctx PConnectField (fun () -> - ignore(read EOM); - ); + let m = read EOT in + delay ctx PConnectField (fun () -> + ignore(read EOM); ); m with e -> 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/Compiler.hx b/std/haxe/macro/Compiler.hx index a2d581985d0..03701de4b96 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. @@ -576,6 +577,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/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..1e7dc411b9f 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:506: 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..3e26bc6c365 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:495: 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..4e87b73bfb0 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:495: characters 11-39 : Called from here (unknown) : Called from here 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 index 2160c2c1753..29619b177df 100644 --- 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 @@ -2,9 +2,9 @@ | Uncaught exception Could not read file meta.jsno - -> $$normPath(::std::)/haxe/macro/Compiler.hx:494: characters 11-39 + -> $$normPath(::std::)/haxe/macro/Compiler.hx:495: characters 11-39 - 494 | var f = sys.io.File.getContent(path); + 495 | var f = sys.io.File.getContent(path); | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^ | Called from here diff --git a/tests/unit/compile-hxb-jvm-roundtrip.hxml b/tests/unit/compile-hxb-jvm-roundtrip.hxml index 90646475c41..121de138f11 100644 --- a/tests/unit/compile-hxb-jvm-roundtrip.hxml +++ b/tests/unit/compile-hxb-jvm-roundtrip.hxml @@ -1,7 +1,7 @@ compile-jvm-only.hxml ---hxb bin/hxb/jvm.zip +--hxb hxb-config/jvm.json --next compile-jvm-only.hxml ---hxb-lib bin/hxb/jvm.zip \ No newline at end of file +--hxb-lib bin/hxb/unit.java.zip \ No newline at end of file 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 + } +} From 8e0855c742be90a73f91fdf046df5209012fdd19 Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Thu, 1 Feb 2024 07:34:33 +0100 Subject: [PATCH 17/51] [jvm] Assign dynamic method only if it's null (#11530) * [jvm] assign dynamic method only if it's null * finalize ctor args --- src/generators/genjvm.ml | 12 +- tests/unit/src/unit/TestMisc.hx | 457 ++++++++++++++++---------------- 2 files changed, 240 insertions(+), 229 deletions(-) diff --git a/src/generators/genjvm.ml b/src/generators/genjvm.ml index 10701eb7738..ca7cbfcb533 100644 --- a/src/generators/genjvm.ml +++ b/src/generators/genjvm.ml @@ -2392,6 +2392,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 @@ -2432,6 +2433,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; @@ -2548,7 +2550,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 -> 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"); From 887272dd1ca306b89c38da448aaf0103c5d14137 Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Thu, 1 Feb 2024 10:26:32 +0100 Subject: [PATCH 18/51] [jvm] fix invokeDynamic arity --- src/generators/jvm/jvmFunctions.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/generators/jvm/jvmFunctions.ml b/src/generators/jvm/jvmFunctions.ml index 1d4058db9f3..af4167b0d8f 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 -> From 2e17ec6c002029e694e3f700653440e5ce55878f Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Thu, 1 Feb 2024 11:19:35 +0100 Subject: [PATCH 19/51] [jvm] use HashMap for IntMap too --- std/jvm/_std/haxe/ds/IntMap.hx | 91 ++++++++++++ tests/unit/src/unit/issues/Issue5862.hx | 181 ++++++++++++------------ 2 files changed, 184 insertions(+), 88 deletions(-) create mode 100644 std/jvm/_std/haxe/ds/IntMap.hx 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/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 } From 1939a7b211ca16f501fa3ebff620d1f47c917b47 Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Thu, 1 Feb 2024 11:32:14 +0100 Subject: [PATCH 20/51] [typer] don't type trailing optional bind arguments so weirdly (#11533) see #11531 --- src/typing/calls.ml | 14 ++++---------- 1 file changed, 4 insertions(+), 10 deletions(-) diff --git a/src/typing/calls.ml b/src/typing/calls.ml index 2839847ec4a..3261058c30b 100644 --- a/src/typing/calls.ml +++ b/src/typing/calls.ml @@ -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) From 7f6d2747dfa60361bf649f3a5632d5ba3e909837 Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Thu, 1 Feb 2024 19:42:40 +0100 Subject: [PATCH 21/51] safeguard against infinite recursion monos --- src/core/tUnification.ml | 32 ++++++++++++++++++++++---------- 1 file changed, 22 insertions(+), 10 deletions(-) diff --git a/src/core/tUnification.ml b/src/core/tUnification.ml index ff6c8f4cc17..d112b2f50b1 100644 --- a/src/core/tUnification.ml +++ b/src/core/tUnification.ml @@ -235,25 +235,37 @@ module Monomorph = struct and close m = match m.tm_type with | Some _ -> () - | None -> match classify_down_constraints m with + | None -> + let recursion_ok t = + let rec loop t = match t with + | TMono m2 when m == m2 -> + raise Exit + | _ -> + TFunctions.iter loop t + in + try + loop t; + true + with Exit -> + false + 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 recursion_ok t 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 -> + if not (recursion_ok cf.cf_type) then begin 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 + let s = Printf.sprintf "%s appears in { %s: %s }" (s_type pctx (TMono m)) 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); + 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; From 60ad1cbd33020e86528dd8c0a7c23c7f3dfb7ff8 Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Thu, 1 Feb 2024 19:54:00 +0100 Subject: [PATCH 22/51] restore previous printing behavior --- src/core/tType.ml | 3 +++ src/core/tUnification.ml | 23 +++++++++++++---------- 2 files changed, 16 insertions(+), 10 deletions(-) diff --git a/src/core/tType.ml b/src/core/tType.ml index a391d4b4210..205d4415e91 100644 --- a/src/core/tType.ml +++ b/src/core/tType.ml @@ -449,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; diff --git a/src/core/tUnification.ml b/src/core/tUnification.ml index d112b2f50b1..16807ceab71 100644 --- a/src/core/tUnification.ml +++ b/src/core/tUnification.ml @@ -236,18 +236,18 @@ module Monomorph = struct | Some _ -> () | None -> - let recursion_ok t = + let get_recursion t = let rec loop t = match t with | TMono m2 when m == m2 -> - raise Exit + raise (Type_exception t) | _ -> TFunctions.iter loop t in try loop t; - true - with Exit -> - false + 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 @@ -256,15 +256,18 @@ module Monomorph = struct () | CTypes [(t,_)] -> (* TODO: silently not binding doesn't seem correct, but it's likely better than infinite recursion *) - if recursion_ok t then do_bind m t; + if get_recursion t = None then do_bind m t; | CTypes _ | CMixed _ -> () | CStructural(fields,_) -> let check_recursion cf = - if not (recursion_ok cf.cf_type) then begin - let pctx = print_context() in - let s = Printf.sprintf "%s appears in { %s: %s }" (s_type pctx (TMono m)) cf.cf_name (s_type pctx cf.cf_type) in - raise (Unify_error [Unify_custom "Recursive type";Unify_custom s]); + 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 *) From 4c9976c0528506ef699fed1c498759f9a88d486a Mon Sep 17 00:00:00 2001 From: Rudy Ges Date: Thu, 1 Feb 2024 07:38:08 +0100 Subject: [PATCH 23/51] Warnings --- src/compiler/hxb/hxbWriterConfig.ml | 1 - 1 file changed, 1 deletion(-) diff --git a/src/compiler/hxb/hxbWriterConfig.ml b/src/compiler/hxb/hxbWriterConfig.ml index a81d4caeec4..ee5932d9afc 100644 --- a/src/compiler/hxb/hxbWriterConfig.ml +++ b/src/compiler/hxb/hxbWriterConfig.ml @@ -1,5 +1,4 @@ open Globals -open Json open Json.Reader type writer_target_config = { From 1dec08e3c1a8fdca8475c02397af7c6a69d09586 Mon Sep 17 00:00:00 2001 From: Rudy Ges Date: Thu, 1 Feb 2024 22:08:48 +0100 Subject: [PATCH 24/51] [server] do not crash when client exits before end of compilation --- src/compiler/server.ml | 15 +++++++++++++-- 1 file changed, 13 insertions(+), 2 deletions(-) diff --git a/src/compiler/server.ml b/src/compiler/server.ml index 17cde830af4..e664d8691a7 100644 --- a/src/compiler/server.ml +++ b/src/compiler/server.ml @@ -923,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 From f4bfd59842bf303a5d492cadb745d5675764302b Mon Sep 17 00:00:00 2001 From: Rudy Ges Date: Thu, 1 Feb 2024 22:14:26 +0100 Subject: [PATCH 25/51] [skip ci] add code-cookbook entry to release checklist --- extra/release-checklist.txt | 1 + 1 file changed, 1 insertion(+) diff --git a/extra/release-checklist.txt b/extra/release-checklist.txt index d8e7603049c..50589471d88 100644 --- a/extra/release-checklist.txt +++ b/extra/release-checklist.txt @@ -24,6 +24,7 @@ - Update https://github.com/HaxeFoundation/haxe.org/blob/staging/downloads/versions.json - Wait for staging to update, check everything related to release and merge to master - Update https://github.com/HaxeFoundation/api.haxe.org/blob/master/theme/templates/topbar.mtt +- Update https://github.com/HaxeFoundation/code-cookbook/blob/master/assets/content/index.mtt#L62-L63 # Cleanup From 8c5e022233bf70a36ace79fa74733aafce27845d Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Fri, 2 Feb 2024 15:07:21 +0100 Subject: [PATCH 26/51] Simplify type parameter typing (#11537) * change type parameter typing to something sensible * type defaults in the shared ttp context too * assign KTypeParameter in mk_type_param * calmly work around C# again --- src/codegen/gencommon/closuresToClass.ml | 7 +- src/codegen/gencommon/gencommon.ml | 4 +- src/compiler/hxb/hxbReader.ml | 4 +- src/context/display/displayTexpr.ml | 8 +-- src/context/typecore.ml | 4 +- src/core/tFunctions.ml | 19 +++--- src/typing/typeload.ml | 83 ++++++++++++------------ src/typing/typeloadFunction.ml | 4 +- src/typing/typeloadModule.ml | 12 ++-- 9 files changed, 72 insertions(+), 73 deletions(-) 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 e48d252c99d..b4af589c180 100644 --- a/src/codegen/gencommon/gencommon.ml +++ b/src/codegen/gencommon/gencommon.ml @@ -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/compiler/hxb/hxbReader.ml b/src/compiler/hxb/hxbReader.ml index 0adc6800bd0..a8cd5651d16 100644 --- a/src/compiler/hxb/hxbReader.ml +++ b/src/compiler/hxb/hxbReader.ml @@ -899,9 +899,7 @@ class hxb_reader | i -> die (Printf.sprintf "Invalid type paramter host: %i" i) __LOC__ in let c = mk_class current_module path pos pos in - let ttp = mk_type_param c host None None in - c.cl_kind <- KTypeParameter ttp; - ttp + mk_type_param c host None None ) method read_type_parameters_data (a : typed_type_param array) = diff --git a/src/context/display/displayTexpr.ml b/src/context/display/displayTexpr.ml index 4b6d0dd845b..105691004e1 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)) diff --git a/src/context/typecore.ml b/src/context/typecore.ml index 04132c0a8af..a949bd405dd 100644 --- a/src/context/typecore.ml +++ b/src/context/typecore.ml @@ -517,9 +517,7 @@ let clone_type_parameter map path ttp = | None -> None | Some constraints -> Some (lazy (List.map map (Lazy.force constraints))) in - let ttp' = mk_type_param c ttp.ttp_host def constraints in - c.cl_kind <- KTypeParameter ttp'; - ttp' + 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 = diff --git a/src/core/tFunctions.ml b/src/core/tFunctions.ml index 25d5abd5824..1c0a68c65e1 100644 --- a/src/core/tFunctions.ml +++ b/src/core/tFunctions.ml @@ -722,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) diff --git a/src/typing/typeload.ml b/src/typing/typeload.ml index 135f988ca60..f31aa999a28 100644 --- a/src/typing/typeload.ml +++ b/src/typing/typeload.ml @@ -726,42 +726,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 + let ttp = mk_type_param c host None None 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 + 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 @@ -771,7 +781,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) @@ -782,18 +792,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 diff --git a/src/typing/typeloadFunction.ml b/src/typing/typeloadFunction.ml index 48f106c30cf..07c06f2e9d5 100644 --- a/src/typing/typeloadFunction.ml +++ b/src/typing/typeloadFunction.ml @@ -44,9 +44,7 @@ let save_field_state ctx = ) 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; diff --git a/src/typing/typeloadModule.ml b/src/typing/typeloadModule.ml index 69380e173d5..697cc2f581e 100644 --- a/src/typing/typeloadModule.ml +++ b/src/typing/typeloadModule.ml @@ -320,7 +320,7 @@ module ModuleLevel = struct 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 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.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; @@ -328,11 +328,11 @@ module ModuleLevel = struct 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 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 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 TPHType a.a_path p d.d_params; | _ -> die "" __LOC__ ) decls @@ -341,9 +341,7 @@ end module TypeLevel = struct let load_enum_field ctx 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 params = type_type_params ctx TPHEnumConstructor ([],fst c.ec_name) c.ec_pos c.ec_params in let ctx = { ctx with type_params = params @ ctx.type_params } in let rt = (match c.ec_type with | None -> et From 2b0e8cead3374f0cab8d52ec0ec9b05e269a6750 Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Fri, 2 Feb 2024 17:29:25 +0100 Subject: [PATCH 27/51] Split up typer context (#11534) * add ctx.c * create class context earlier to avoid some heritage awkwardness * add ctx.e * start on ctx.f * curfield * vthis * untyped * in_loop * bypass_accessor & meta * with_type_stack & call_argument_stack * in_call_args & in_overload_call_args * in_display * is_display_file * in_call_args needs to be on ctx.f also do some cleanup * why did I change that * macro_depth * delayed_display * allow_inline & allow_tranform * rename to ctx_c to make difference visible * more renaming, less ctx because that will totally fix something * I'm committed now * make some context cloning explicit * clone for enum fields too and random cleanup * Revert "allow_inline & allow_tranform" This reverts commit f35e83c526d583c3ef2f25ed76625308c2a82684. --------- Co-authored-by: Rudy Ges --- src/context/abstractCast.ml | 8 +- src/context/display/displayEmitter.ml | 2 +- src/context/display/displayFields.ml | 10 +- src/context/display/displayPath.ml | 1 - src/context/display/displayTexpr.ml | 4 +- src/context/display/displayToplevel.ml | 26 +-- src/context/display/importHandling.ml | 2 +- src/context/typecore.ml | 222 +++++++++++++++----- src/filters/exceptions.ml | 4 +- src/filters/filters.ml | 6 +- src/filters/filtersCommon.ml | 6 +- src/filters/localStatic.ml | 6 +- src/filters/tre.ml | 10 +- src/optimization/inline.ml | 4 +- src/optimization/inlineConstructors.ml | 4 +- src/optimization/optimizer.ml | 2 +- src/typing/callUnification.ml | 44 ++-- src/typing/calls.ml | 20 +- src/typing/fields.ml | 46 ++-- src/typing/forLoop.ml | 8 +- src/typing/functionArguments.ml | 6 +- src/typing/generic.ml | 4 +- src/typing/instanceBuilder.ml | 26 +-- src/typing/macroContext.ml | 36 ++-- src/typing/matcher.ml | 2 +- src/typing/matcher/case.ml | 10 +- src/typing/matcher/exprToPattern.ml | 22 +- src/typing/operators.ml | 2 +- src/typing/typeload.ml | 21 +- src/typing/typeloadCheck.ml | 15 +- src/typing/typeloadFields.ml | 103 ++++----- src/typing/typeloadFunction.ml | 64 +++--- src/typing/typeloadModule.ml | 278 +++++++++++-------------- src/typing/typer.ml | 176 ++++++++-------- src/typing/typerBase.ml | 30 +-- src/typing/typerDisplay.ml | 32 +-- src/typing/typerEntry.ml | 34 +-- 37 files changed, 659 insertions(+), 637 deletions(-) diff --git a/src/context/abstractCast.ml b/src/context/abstractCast.ml index b26f26d980d..162af836fe2 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)) = @@ -118,7 +118,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/display/displayEmitter.ml b/src/context/display/displayEmitter.ml index 9f50cef7905..58b50c7d25f 100644 --- a/src/context/display/displayEmitter.ml +++ b/src/context/display/displayEmitter.ml @@ -71,7 +71,7 @@ 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(); diff --git a/src/context/display/displayFields.ml b/src/context/display/displayFields.ml index 8540e92fb99..234cf6d460f 100644 --- a/src/context/display/displayFields.ml +++ b/src/context/display/displayFields.ml @@ -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 @@ -402,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 -> @@ -412,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/displayPath.ml b/src/context/display/displayPath.ml index a10ab00bf7d..87940cfa93a 100644 --- a/src/context/display/displayPath.ml +++ b/src/context/display/displayPath.ml @@ -165,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 105691004e1..777ba93ef24 100644 --- a/src/context/display/displayTexpr.ml +++ b/src/context/display/displayTexpr.ml @@ -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 diff --git a/src/context/display/displayToplevel.ml b/src/context/display/displayToplevel.ml index 32d9afeda3d..facb253d13b 100644 --- a/src/context/display/displayToplevel.ml +++ b/src/context/display/displayToplevel.ml @@ -227,7 +227,7 @@ let is_pack_visible pack = let collect ctx tk with_type sort = 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 @@ -302,7 +302,7 @@ let collect ctx tk with_type sort = 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 = @@ -331,22 +331,22 @@ let collect ctx tk with_type sort = 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 @@ -355,7 +355,7 @@ 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(); @@ -363,7 +363,7 @@ let collect ctx tk with_type sort = (* 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 @@ -433,16 +433,16 @@ let collect ctx tk with_type sort = 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"); | _ -> () diff --git a/src/context/display/importHandling.ml b/src/context/display/importHandling.ml index cb7e9f42367..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 = diff --git a/src/context/typecore.ml b/src/context/typecore.ml index a949bd405dd..180b14daaf7 100644 --- a/src/context/typecore.ml +++ b/src/context/typecore.ml @@ -73,6 +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 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 = @@ -118,6 +125,7 @@ type typer_globals = { 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); @@ -128,43 +136,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; } @@ -173,6 +183,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 @@ -252,7 +362,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 @@ -279,7 +389,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 @@ -288,17 +398,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 = @@ -319,8 +429,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 @@ -328,7 +438,7 @@ 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 (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; @@ -340,7 +450,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 = @@ -523,7 +633,7 @@ let clone_type_parameter map path ttp = 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' -> @@ -576,24 +686,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 -> @@ -616,10 +726,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 *) @@ -703,11 +813,11 @@ let mk_infos ctx p params = (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 @@ -754,8 +864,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; } @@ -801,14 +911,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/filters/exceptions.ml b/src/filters/exceptions.ml index d913b4a993a..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 (** @@ -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 c3314b9243a..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; @@ -811,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 43494cf1374..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 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/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 9da0e9c3198..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,8 +506,8 @@ 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 @@ -538,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 3261058c30b..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 @@ -468,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 b1c29238caf..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,30 +191,30 @@ 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 = ( - 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 @@ -234,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) -> @@ -382,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; @@ -426,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 @@ -441,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 | _ -> @@ -572,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 @@ -594,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/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 b6f94bd339f..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)) @@ -354,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; 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 8a85aa0cdb2..b76ddbec32c 100644 --- a/src/typing/macroContext.ml +++ b/src/typing/macroContext.ml @@ -79,7 +79,7 @@ let macro_timer com l = 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) @@ -94,7 +94,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 @@ -453,7 +453,7 @@ let make_macro_api ctx mctx p = 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) @@ -462,23 +462,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; @@ -487,10 +487,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) ); @@ -537,7 +537,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; @@ -682,7 +682,7 @@ 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; ] in let ready = fun t -> @@ -750,7 +750,7 @@ let create_macro_context com = 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 @@ -780,6 +780,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) @@ -821,6 +822,7 @@ let load_macro'' com mctx display cpath f p = enum_with_type = None; module_using = []; import_statements = []; + is_display_file = false; }; t(); meth @@ -1002,7 +1004,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 @@ -1013,14 +1015,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 @@ -1034,7 +1036,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) 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/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/typeload.ml b/src/typing/typeload.ml index f31aa999a28..7bc27105321 100644 --- a/src/typing/typeload.ml +++ b/src/typing/typeload.ml @@ -229,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 @@ -280,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 | _ -> @@ -449,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 @@ -459,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 @@ -610,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; @@ -708,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__ @@ -718,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 @@ -733,7 +728,7 @@ let rec type_type_param ctx host path p tp = c.cl_meta <- tp.Ast.tp_meta; if host = TPHEnumConstructor then c.cl_meta <- (Meta.EnumConstructorParam,[],null_pos) :: c.cl_meta; let ttp = mk_type_param c host None None in - if ctx.is_display_file && DisplayPosition.display_position#enclosed_in (pos tp.tp_name) then + 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 diff --git a/src/typing/typeloadCheck.ml b/src/typing/typeloadCheck.ml index d0cacbff8a0..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 @@ -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 80a2b395657..1c335511c76 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; @@ -466,10 +466,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) @@ -554,19 +554,7 @@ let create_typer_context_for_class ctx cctx p = 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 = (match c.cl_kind with KAbstractImpl a -> a.a_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 @@ -627,17 +615,9 @@ 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 = []; - }; - type_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 + 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 @@ -696,7 +676,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 @@ -850,7 +830,7 @@ module TypeBinding = struct let r = make_lazy ~force:false ctx t (fun r -> (* type constant init fields (issue #1956) *) 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.curclass.cl_path @ [snd ctx.curclass.cl_path;ctx.curfield.cf_name]); + 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 @@ -880,7 +860,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 | _ -> @@ -1031,7 +1011,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 @@ -1274,7 +1254,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 @@ -1341,7 +1321,7 @@ let create_method (ctx,cctx,fctx) c f fd 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 @@ -1386,7 +1366,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 @@ -1428,7 +1408,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 @@ -1586,7 +1566,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 @@ -1694,7 +1674,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; @@ -1727,19 +1707,18 @@ let check_functional_interface ctx c = add_class_flag c CFunctionalInterface; ctx.g.functional_interface_lut#add c.cl_path 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 = patch_class ctx_c c fields in + 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 @@ -1760,7 +1739,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 @@ -1773,10 +1752,10 @@ let init_class ctx c p herits fields = 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 = CfrInit then begin @@ -1842,7 +1821,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; @@ -1850,11 +1829,11 @@ 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 CInterface) && ctx.com.platform = Java then check_functional_interface ctx c; + if (has_class_flag c CInterface) && 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 PConnectField (fun () -> match follow c.cl_type with + delay ctx_c PConnectField (fun () -> match follow c.cl_type with | TAnon an -> an.a_fields <- c.cl_statics | _ -> @@ -1872,28 +1851,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 07c06f2e9d5..d3dff29cd54 100644 --- a/src/typing/typeloadFunction.ml +++ b/src/typing/typeloadFunction.ml @@ -28,32 +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 = 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 @@ -63,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)); @@ -110,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) -> @@ -141,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 @@ -168,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 @@ -177,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 @@ -186,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) = @@ -242,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 697cc2f581e..1966c5eb1d5 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 @@ -267,8 +267,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 +282,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 +294,13 @@ module ModuleLevel = struct r with Not_found -> if Sys.file_exists path then begin - let _,r = match !TypeloadParse.parse_hook com (ClassPaths.create_resolved_file path ctx.com.empty_class_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,39 +313,39 @@ 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 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.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 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 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 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 = type_type_params ctx TPHEnumConstructor ([],fst c.ec_name) c.ec_pos c.ec_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 -> () @@ -363,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 = { @@ -376,44 +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; - if ctx.is_display_file && DisplayPosition.display_position#enclosed_in f.ef_name_pos then - DisplayEmitter.display_enum_field ctx e f p; + 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 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; + 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 (ctx.g.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); - ctx.g.build_count <- ctx.g.build_count + 1; + 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 ctx.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.g.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 -> @@ -425,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 @@ -447,12 +446,12 @@ 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; + 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 + let h = (try Some (Hashtbl.find ctx_en.g.type_patches e.e_path) with Not_found -> None) 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; (match h with | None -> () | Some (h,hcl) -> @@ -473,7 +472,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 -> @@ -503,35 +502,35 @@ module TypeLevel = struct let is_flat = ref true 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 = 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; 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,[])) 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" }} -> @@ -557,7 +556,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 @@ -570,25 +569,25 @@ 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; + 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 @@ -608,8 +607,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) -> @@ -636,54 +635,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; @@ -691,79 +691,43 @@ 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 = @@ -778,7 +742,7 @@ class hxb_reader_api_typeload (p : pos) = object(self) method make_module (path : path) (file : string) = - let m = ModuleLevel.make_module ctx path file p in + let m = ModuleLevel.make_module ctx.com ctx.g path file p in m.m_extra.m_processed <- 1; m 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 5cfc5f70074..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 @@ -211,7 +211,7 @@ let type_module_type ctx t 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) -> @@ -334,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 ac504cbe7bf..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 @@ -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 27637158004..a624db3b880 100644 --- a/src/typing/typerEntry.ml +++ b/src/typing/typerEntry.ml @@ -36,6 +36,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; @@ -44,36 +45,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 From d9fc90a8501a02580fa2dbf7492a30ef785cc913 Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Sat, 3 Feb 2024 09:20:47 +0100 Subject: [PATCH 28/51] [hxb] remove writer stats I broke parts of it already anyway. --- src/compiler/compilationCache.ml | 4 +- src/compiler/generate.ml | 2 +- src/compiler/hxb/hxbWriter.ml | 83 ++------------------------------ src/context/common.ml | 3 -- src/context/commonCache.ml | 3 +- 5 files changed, 9 insertions(+), 86 deletions(-) diff --git a/src/compiler/compilationCache.ml b/src/compiler/compilationCache.ml index b7c8ea854cc..0b4b2a0b455 100644 --- a/src/compiler/compilationCache.ml +++ b/src/compiler/compilationCache.ml @@ -69,12 +69,12 @@ class context_cache (index : int) (sign : Digest.t) = object(self) 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 hxb_writer_stats path m = + 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 hxb_writer_stats in + 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 { diff --git a/src/compiler/generate.ml b/src/compiler/generate.ml index e12e22e372b..04718ece5e0 100644 --- a/src/compiler/generate.ml +++ b/src/compiler/generate.ml @@ -42,7 +42,7 @@ let export_hxb com config cc platform zip m = 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 com.hxb_writer_stats 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; diff --git a/src/compiler/hxb/hxbWriter.ml b/src/compiler/hxb/hxbWriter.ml index 39cde88c266..cc2d1c1065c 100644 --- a/src/compiler/hxb/hxbWriter.ml +++ b/src/compiler/hxb/hxbWriter.ml @@ -45,63 +45,6 @@ let unop_index op flag = match op,flag with | NegBits,Postfix -> 10 | Spread,Postfix -> 11 -type hxb_writer_stats = { - type_instance_kind_writes : int array; - texpr_writes : int array; - type_instance_immediate : int ref; - type_instance_cache_hits : int ref; - type_instance_cache_misses : int ref; - pos_writes_full : int ref; - pos_writes_min : int ref; - pos_writes_max : int ref; - pos_writes_minmax : int ref; - pos_writes_eq : int ref; - chunk_sizes : (string,int ref * int ref) Hashtbl.t; -} - -let create_hxb_writer_stats () = { - type_instance_kind_writes = Array.make 255 0; - texpr_writes = Array.make 255 0; - type_instance_immediate = ref 0; - type_instance_cache_hits = ref 0; - type_instance_cache_misses = ref 0; - pos_writes_full = ref 0; - pos_writes_min = ref 0; - pos_writes_max = ref 0; - pos_writes_minmax = ref 0; - pos_writes_eq = ref 0; - chunk_sizes = Hashtbl.create 0; -} - -let dump_stats name stats = - let sort_and_filter_array a = - let _,kind_writes = Array.fold_left (fun (index,acc) writes -> - (index + 1,if writes = 0 then acc else (index,writes) :: acc) - ) (0,[]) a in - let kind_writes = List.sort (fun (_,writes1) (_,writes2) -> compare writes2 writes1) kind_writes in - List.map (fun (index,writes) -> Printf.sprintf " %3i: %9i" index writes) kind_writes - in - let t_kind_writes = sort_and_filter_array stats.type_instance_kind_writes in - print_endline (Printf.sprintf "hxb_writer stats for %s" name); - print_endline " type instance kind writes:"; - List.iter print_endline t_kind_writes; - let texpr_writes = sort_and_filter_array stats.texpr_writes in - print_endline " texpr writes:"; - List.iter print_endline texpr_writes; - - print_endline " type instance writes:"; - print_endline (Printf.sprintf " immediate: %9i" !(stats.type_instance_immediate)); - print_endline (Printf.sprintf " cache hits: %9i" !(stats.type_instance_cache_hits)); - print_endline (Printf.sprintf " cache miss: %9i" !(stats.type_instance_cache_misses)); - print_endline " pos writes:"; - print_endline (Printf.sprintf " full: %9i\n min: %9i\n max: %9i\n minmax: %9i\n equal: %9i" !(stats.pos_writes_full) !(stats.pos_writes_min) !(stats.pos_writes_max) !(stats.pos_writes_minmax) !(stats.pos_writes_eq)); - (* let chunk_sizes = Hashtbl.fold (fun name (imin,imax) acc -> (name,!imin,!imax) :: acc) stats.chunk_sizes [] in - let chunk_sizes = List.sort (fun (_,imin1,imax1) (_,imin2,imax2) -> compare imax1 imax2) chunk_sizes in - print_endline "chunk sizes:"; - List.iter (fun (name,imin,imax) -> - print_endline (Printf.sprintf " %s: %i - %i" name imin imax) - ) chunk_sizes *) - module StringHashtbl = Hashtbl.Make(struct type t = string @@ -400,17 +343,10 @@ module Chunk = struct let write_bool io b = write_u8 io (if b then 1 else 0) - let export : 'a . hxb_writer_stats -> t -> 'a IO.output -> unit = fun stats io chex -> + 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; - (* begin try - let (imin,imax) = Hashtbl.find stats.chunk_sizes io.name in - if length < !imin then imin := length; - if length > !imax then imax := length - with Not_found -> - Hashtbl.add stats.chunk_sizes io.name (ref length,ref length); - end; *) IO.nwrite chex bytes let write_string chunk s = @@ -438,22 +374,19 @@ end module PosWriter = struct type t = { - stats : hxb_writer_stats; mutable p_file : string; mutable p_min : int; mutable p_max : int; } let do_write_pos (chunk : Chunk.t) (p : pos) = - (* incr stats.pos_writes_full; *) Chunk.write_string chunk p.pfile; Chunk.write_leb128 chunk p.pmin; Chunk.write_leb128 chunk p.pmax - let create stats chunk p = + let create chunk p = do_write_pos chunk p; { - stats; p_file = p.pfile; p_min = p.pmin; p_max = p.pmax; @@ -470,7 +403,6 @@ module PosWriter = struct end else if p.pmin <> pw.p_min then begin if p.pmax <> pw.p_max then begin (* pmin and pmax changed *) - (* incr stats.pos_writes_minmax; *) Chunk.write_u8 chunk (3 + offset); Chunk.write_leb128 chunk p.pmin; Chunk.write_leb128 chunk p.pmax; @@ -478,19 +410,16 @@ module PosWriter = struct pw.p_max <- p.pmax; end else begin (* pmin changed *) - (* incr stats.pos_writes_min; *) 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 *) - (* incr stats.pos_writes_max; *) Chunk.write_u8 chunk (2 + offset); Chunk.write_leb128 chunk p.pmax; pw.p_max <- p.pmax; end else begin - (* incr stats.pos_writes_eq; *) if write_equal then Chunk.write_u8 chunk offset; end @@ -514,7 +443,6 @@ type hxb_writer = { config : HxbWriterConfig.writer_target_config; warn : Warning.warning -> string -> Globals.pos -> unit; anon_id : Type.t Tanon_identification.tanon_identification; - stats : hxb_writer_stats; mutable current_module : module_def; chunks : Chunk.t DynArray.t; cp : StringPool.t; @@ -1794,7 +1722,7 @@ module HxbWriter = struct and start_texpr writer (p: pos) = let restore = start_temporary_chunk writer 512 in - let fctx = create_field_writer_context (PosWriter.create writer.stats writer.chunk p) 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 @@ -2287,13 +2215,12 @@ module HxbWriter = struct l end -let create config warn anon_id stats = +let create config warn anon_id = let cp = StringPool.create () in { config; warn; anon_id; - stats; current_module = null_module; chunks = DynArray.create (); cp = cp; @@ -2333,5 +2260,5 @@ 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 writer.stats io ch + Chunk.export io ch ) l diff --git a/src/context/common.ml b/src/context/common.ml index e1e3577f8b0..db30ae055ee 100644 --- a/src/context/common.ml +++ b/src/context/common.ml @@ -420,7 +420,6 @@ type context = { mutable basic : basic_types; memory_marker : float array; hxb_reader_stats : HxbReader.hxb_reader_stats; - hxb_writer_stats : HxbWriter.hxb_writer_stats; mutable hxb_writer_config : HxbWriterConfig.t option; } @@ -883,7 +882,6 @@ let create compilation_step cs version args display_mode = report_mode = RMNone; is_macro_context = false; hxb_reader_stats = HxbReader.create_hxb_reader_stats (); - hxb_writer_stats = HxbWriter.create_hxb_writer_stats (); hxb_writer_config = None; } in com @@ -935,7 +933,6 @@ let clone com is_macro_context = overload_cache = new hashtbl_lookup; module_lut = new module_lut; hxb_reader_stats = HxbReader.create_hxb_reader_stats (); - hxb_writer_stats = HxbWriter.create_hxb_writer_stats (); std = null_class; empty_class_path = new ClassPath.directory_class_path "" User; class_paths = new ClassPaths.class_paths; diff --git a/src/context/commonCache.ml b/src/context/commonCache.ml index 312d5cc723c..d2c7db7796c 100644 --- a/src/context/commonCache.ml +++ b/src/context/commonCache.ml @@ -95,7 +95,7 @@ let rec cache_context cs com = (* 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 let warn w s p = com.warning w com.warning_options s p in - cc#cache_module config warn anon_identification com.hxb_writer_stats m.m_path m; + cc#cache_module config warn anon_identification m.m_path m; in List.iter cache_module com.modules; begin match com.get_macros() with @@ -104,7 +104,6 @@ let rec 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; - HxbWriter.dump_stats (platform_name com.platform) com.hxb_writer_stats end let maybe_add_context_sign cs com desc = From 4260da3c6f98dd55b64c001f4ae7896531d5e864 Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Sat, 3 Feb 2024 09:48:23 +0100 Subject: [PATCH 29/51] Remove some API from haxe.macro.Compiler (#11540) * remove some API from haxe.macro.Compiler * js fixes * never mind --- src/context/typecore.ml | 1 - src/macro/macroApi.ml | 10 -- src/typing/macroContext.ml | 46 ------- src/typing/typeloadFields.ml | 70 ----------- src/typing/typeloadModule.ml | 6 - src/typing/typerEntry.ml | 1 - std/haxe/macro/Compiler.hx | 115 +----------------- tests/misc/es6/Test.hx | 2 +- .../user-defined-define-json-fail.hxml.stderr | 2 +- .../user-defined-meta-json-fail.hxml.stderr | 2 +- ...-defined-meta-json-indent-fail.hxml.stderr | 2 +- ...-defined-meta-json-pretty-fail.hxml.stderr | 4 +- tests/misc/projects/Issue4660/Include.hx | 2 +- tests/misc/projects/Issue8567/compile.hxml | 3 - tests/misc/projects/Issue8567/src/Main.hx | 4 - tests/misc/projects/Issue8567/src/test.txt | 0 16 files changed, 12 insertions(+), 258 deletions(-) delete mode 100644 tests/misc/projects/Issue8567/compile.hxml delete mode 100644 tests/misc/projects/Issue8567/src/Main.hx delete mode 100644 tests/misc/projects/Issue8567/src/test.txt diff --git a/src/context/typecore.ml b/src/context/typecore.ml index 180b14daaf7..730c05259b8 100644 --- a/src/context/typecore.ml +++ b/src/context/typecore.ml @@ -114,7 +114,6 @@ type typer_globals = { 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 *) diff --git a/src/macro/macroApi.ml b/src/macro/macroApi.ml index d7b1b8f97eb..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; @@ -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 diff --git a/src/typing/macroContext.ml b/src/typing/macroContext.ml index b76ddbec32c..b17f1a2b103 100644 --- a/src/typing/macroContext.ml +++ b/src/typing/macroContext.ml @@ -51,28 +51,6 @@ 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"]) @@ -222,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; @@ -434,24 +406,6 @@ 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.c.get_build_infos() with | Some (mt,tl,_) -> diff --git a/src/typing/typeloadFields.ml b/src/typing/typeloadFields.ml index 1c335511c76..f49140384ff 100644 --- a/src/typing/typeloadFields.ml +++ b/src/typing/typeloadFields.ml @@ -282,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 () @@ -1710,7 +1641,6 @@ let check_functional_interface ctx c = 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 c fields in 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 diff --git a/src/typing/typeloadModule.ml b/src/typing/typeloadModule.ml index 1966c5eb1d5..35889603d3a 100644 --- a/src/typing/typeloadModule.ml +++ b/src/typing/typeloadModule.ml @@ -450,13 +450,7 @@ module TypeLevel = struct 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 - let h = (try Some (Hashtbl.find ctx_en.g.type_patches e.e_path) with Not_found -> None) 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; - (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 constructs = ref d.d_data in let get_constructs() = List.map (fun c -> diff --git a/src/typing/typerEntry.ml b/src/typing/typerEntry.ml index a624db3b880..72ae8d3bf57 100644 --- a/src/typing/typerEntry.ml +++ b/src/typing/typerEntry.ml @@ -13,7 +13,6 @@ let create com macros = g = { core_api = None; macros = macros; - type_patches = Hashtbl.create 0; module_check_policies = []; delayed = Array.init all_typer_passes_length (fun _ -> { tasks = []}); delayed_min_index = 0; diff --git a/std/haxe/macro/Compiler.hx b/std/haxe/macro/Compiler.hx index 03701de4b96..1ba1ed88e6f 100644 --- a/std/haxe/macro/Compiler.hx +++ b/std/haxe/macro/Compiler.hx @@ -77,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. @@ -374,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. @@ -487,6 +377,11 @@ class Compiler { #end } + public static function addMetadata(meta:String, className:String, ?field:String, ?isStatic:Bool) { + var pathFilter = field == null ? className : '$className.$field'; + addGlobalMetadata(pathFilter, meta, true, field == null, field != null); + } + /** Reference a json file describing user-defined metadata See https://github.com/HaxeFoundation/haxe/blob/development/src-json/meta.json 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/projects/Issue10844/user-defined-define-json-fail.hxml.stderr b/tests/misc/projects/Issue10844/user-defined-define-json-fail.hxml.stderr index 1e7dc411b9f..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:506: 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 3e26bc6c365..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:495: 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 4e87b73bfb0..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:495: 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.stderr b/tests/misc/projects/Issue10844/user-defined-meta-json-pretty-fail.hxml.stderr index 29619b177df..6c235767c49 100644 --- 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 @@ -2,9 +2,9 @@ | Uncaught exception Could not read file meta.jsno - -> $$normPath(::std::)/haxe/macro/Compiler.hx:495: characters 11-39 + -> $$normPath(::std::)/haxe/macro/Compiler.hx:390: characters 11-39 - 495 | var f = sys.io.File.getContent(path); + 390 | var f = sys.io.File.getContent(path); | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^ | Called from here 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/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 From 2f56f2cb21bb13b8c4e8b73600dcc8873e8c29fb Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Sat, 3 Feb 2024 18:01:58 +0100 Subject: [PATCH 30/51] don't recurse --- std/haxe/macro/Compiler.hx | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/std/haxe/macro/Compiler.hx b/std/haxe/macro/Compiler.hx index 1ba1ed88e6f..c1996cfddaf 100644 --- a/std/haxe/macro/Compiler.hx +++ b/std/haxe/macro/Compiler.hx @@ -379,7 +379,7 @@ class Compiler { public static function addMetadata(meta:String, className:String, ?field:String, ?isStatic:Bool) { var pathFilter = field == null ? className : '$className.$field'; - addGlobalMetadata(pathFilter, meta, true, field == null, field != null); + addGlobalMetadata(pathFilter, meta, false, field == null, field != null); } /** From 23c865f56c92a7541fb70da927c7abfedfba9070 Mon Sep 17 00:00:00 2001 From: Rudy Ges Date: Sat, 3 Feb 2024 21:40:15 +0100 Subject: [PATCH 31/51] [tests] update test for #3500 --- tests/misc/projects/Issue3500/Main.hx | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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"); } From 769917217358d0b9d54e0ef9bd78aa3171b1019e Mon Sep 17 00:00:00 2001 From: Rudy Ges Date: Sat, 3 Feb 2024 21:43:02 +0100 Subject: [PATCH 32/51] [typer] move abstract -> impl meta inheritance to after addGlobalMetadata --- src/typing/typeloadModule.ml | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/src/typing/typeloadModule.ml b/src/typing/typeloadModule.ml index 35889603d3a..701dd8913ee 100644 --- a/src/typing/typeloadModule.ml +++ b/src/typing/typeloadModule.ml @@ -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; @@ -574,6 +568,14 @@ module TypeLevel = struct 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 = From 75c573c588caf81f0f2d5f4a07485e4a54afd9b7 Mon Sep 17 00:00:00 2001 From: Rudy Ges Date: Sat, 3 Feb 2024 22:15:31 +0100 Subject: [PATCH 33/51] [tests] remove test with pretty errors that brings nothing but pain --- .../user-defined-meta-json-pretty-fail.hxml | 4 ---- .../user-defined-meta-json-pretty-fail.hxml.stderr | 12 ------------ 2 files changed, 16 deletions(-) delete mode 100644 tests/misc/projects/Issue10844/user-defined-meta-json-pretty-fail.hxml delete mode 100644 tests/misc/projects/Issue10844/user-defined-meta-json-pretty-fail.hxml.stderr 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 6c235767c49..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:390: characters 11-39 - - 390 | var f = sys.io.File.getContent(path); - | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^ - | Called from here - - | Called from here - From 48b51891485048c76dee9e6566e54c54d6eac814 Mon Sep 17 00:00:00 2001 From: Rudy Ges Date: Sat, 3 Feb 2024 22:15:50 +0100 Subject: [PATCH 34/51] [std] deprecate Compiler.addMetadata again --- std/haxe/macro/Compiler.hx | 1 + 1 file changed, 1 insertion(+) diff --git a/std/haxe/macro/Compiler.hx b/std/haxe/macro/Compiler.hx index c1996cfddaf..854082e4e31 100644 --- a/std/haxe/macro/Compiler.hx +++ b/std/haxe/macro/Compiler.hx @@ -377,6 +377,7 @@ 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); From 2cecaff3f0492129cbfa920dcad190c527b29f52 Mon Sep 17 00:00:00 2001 From: Rudy Ges Date: Sat, 3 Feb 2024 22:16:34 +0100 Subject: [PATCH 35/51] [tests] misc tests: ignore position changes for std modules Closes #11539 --- tests/misc/src/Main.hx | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/tests/misc/src/Main.hx b/tests/misc/src/Main.hx index 4f387cc95d1..63607bdd21a 100644 --- a/tests/misc/src/Main.hx +++ b/tests/misc/src/Main.hx @@ -151,6 +151,9 @@ class Main { .filter(s -> 0 != s.indexOf('Picked up JAVA_TOOL_OPTIONS:')) .join('\n'); + content = hideStdPositions(content); + expected = hideStdPositions(expected); + if (StringTools.startsWith(content, '{"jsonrpc":')) { try { content = haxe.Json.stringify(haxe.Json.parse(content).result.result); @@ -178,6 +181,15 @@ class Main { return true; } + static function hideStdPositions(content:String):String { + var std = Path.removeTrailingSlashes(getStd()); + var regex = new EReg(std + '([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()}; From 8a255c841b33b602437f9aa5db57cb7c5a26c46a Mon Sep 17 00:00:00 2001 From: Rudy Ges Date: Sat, 3 Feb 2024 22:27:02 +0100 Subject: [PATCH 36/51] [tests] improve std position hiding a bit --- tests/misc/src/Main.hx | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/tests/misc/src/Main.hx b/tests/misc/src/Main.hx index 63607bdd21a..006fcfad174 100644 --- a/tests/misc/src/Main.hx +++ b/tests/misc/src/Main.hx @@ -151,15 +151,15 @@ class Main { .filter(s -> 0 != s.indexOf('Picked up JAVA_TOOL_OPTIONS:')) .join('\n'); - content = hideStdPositions(content); - expected = hideStdPositions(expected); - if (StringTools.startsWith(content, '{"jsonrpc":')) { try { content = haxe.Json.stringify(haxe.Json.parse(content).result.result); // Reorder fields from expected too expected = haxe.Json.stringify(haxe.Json.parse(expected)); } catch (_) {} + } else { + content = hideStdPositions(content); + expected = hideStdPositions(expected); } if (content != expected) { @@ -182,8 +182,7 @@ class Main { } static function hideStdPositions(content:String):String { - var std = Path.removeTrailingSlashes(getStd()); - var regex = new EReg(std + '([a-z/]+\\.hx):[0-9]+:( characters? [0-9]+(-[0-9]+)( :)?)', 'i'); + 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:???:")) From 732be46cad4ac7edef88886d3612a71c726b54a7 Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Sun, 4 Feb 2024 08:10:27 +0100 Subject: [PATCH 37/51] remove all "Something went wrong" errors --- src/generators/genjvm.ml | 2 +- src/generators/genshared.ml | 9 +++++---- src/macro/eval/evalEmitter.ml | 4 ++-- src/macro/eval/evalExceptions.ml | 6 +++--- src/macro/eval/evalJit.ml | 2 +- src/typing/matcher/texprConverter.ml | 2 +- 6 files changed, 13 insertions(+), 12 deletions(-) diff --git a/src/generators/genjvm.ml b/src/generators/genjvm.ml index ca7cbfcb533..ea90c8c5868 100644 --- a/src/generators/genjvm.ml +++ b/src/generators/genjvm.ml @@ -1675,7 +1675,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 diff --git a/src/generators/genshared.ml b/src/generators/genshared.ml index aa6c7bab126..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 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/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 From 782c520c556a9f2f8769da448f6ad7e2c48a5ceb Mon Sep 17 00:00:00 2001 From: Rudy Ges Date: Sun, 4 Feb 2024 08:34:25 +0100 Subject: [PATCH 38/51] [tests] well ofc there's windows too.. --- tests/misc/src/Main.hx | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/misc/src/Main.hx b/tests/misc/src/Main.hx index 006fcfad174..67684712571 100644 --- a/tests/misc/src/Main.hx +++ b/tests/misc/src/Main.hx @@ -182,7 +182,7 @@ class Main { } static function hideStdPositions(content:String):String { - var regex = new EReg(getStd() + '([a-z/]+\\.hx):[0-9]+:( characters? [0-9]+(-[0-9]+)( :)?)', 'i'); + 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:???:")) From 61fae054de31a5f04070263d2caa5859f1248d04 Mon Sep 17 00:00:00 2001 From: Rudy Ges Date: Sun, 4 Feb 2024 09:21:41 +0100 Subject: [PATCH 39/51] [tests] need to escape those slashes on windows --- tests/misc/src/Main.hx | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/misc/src/Main.hx b/tests/misc/src/Main.hx index 67684712571..7e05e1da364 100644 --- a/tests/misc/src/Main.hx +++ b/tests/misc/src/Main.hx @@ -182,7 +182,7 @@ class Main { } static function hideStdPositions(content:String):String { - var regex = new EReg(getStd() + '([a-z/\\\\]+\\.hx):[0-9]+:( characters? [0-9]+(-[0-9]+)( :)?)', 'i'); + var regex = new EReg(StringTools.replace(getStd(), '\\', '(?:\\\\|/)') + '([a-z/\\\\]+\\.hx):[0-9]+:( characters? [0-9]+(-[0-9]+)( :)?)', 'i'); return content.split("\n") .map(line -> regex.replace(line, "$1:???:")) From c55da75267dbe1c6011432a1b30644da2b7ba79d Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Sun, 4 Feb 2024 13:44:36 +0100 Subject: [PATCH 40/51] [typer] don't consider @:structInit + @:from when inferring closes #11535 --- src/typing/matcher/exprToPattern.ml | 2 +- src/typing/typer.ml | 30 +++++++++------------ src/typing/typerBase.ml | 8 ++++-- tests/unit/src/unit/issues/Issue11535.hx | 34 ++++++++++++++++++++++++ 4 files changed, 54 insertions(+), 20 deletions(-) create mode 100644 tests/unit/src/unit/issues/Issue11535.hx diff --git a/src/typing/matcher/exprToPattern.ml b/src/typing/matcher/exprToPattern.ml index 3db86b92e1a..4ca68a1c4a2 100644 --- a/src/typing/matcher/exprToPattern.ml +++ b/src/typing/matcher/exprToPattern.ml @@ -315,7 +315,7 @@ let rec make pctx toplevel t e = PatConstructor(con_array (List.length patterns) (pos e),patterns) | TAbstract(a,tl) as t when not (List.exists (fun t' -> shallow_eq t t') seen) -> begin match TyperBase.get_abstract_froms ctx a tl with - | [t2] -> pattern (t :: seen) t2 + | [(_,t2)] -> pattern (t :: seen) t2 | _ -> fail() end | _ -> diff --git a/src/typing/typer.ml b/src/typing/typer.ml index 13aca40a8de..57778ec4f16 100644 --- a/src/typing/typer.ml +++ b/src/typing/typer.ml @@ -96,7 +96,7 @@ let maybe_type_against_enum ctx f with_type iscall p = false,a.a_path,fields,TAbstractDecl a | TAbstract (a,pl) when not (Meta.has Meta.CoreType a.a_meta) -> begin match get_abstract_froms ctx a pl with - | [t2] -> + | [(_,t2)] -> if (List.exists (shallow_eq t) stack) then raise Exit; loop (t :: stack) t2 | _ -> raise Exit @@ -782,14 +782,15 @@ and type_object_decl ctx fl with_type p = let dynamic_parameter = ref None in let a = (match with_type with | WithType.WithType(t,_) -> - let rec loop seen t = + let rec loop had_cast seen t = match follow t with - | TAnon a -> ODKWithStructure a + | TAnon a -> + ODKWithStructure a | TAbstract (a,pl) as t when not (Meta.has Meta.CoreType a.a_meta) && not (List.exists (fun t' -> shallow_eq t t') seen) -> let froms = get_abstract_froms ctx a pl in - let fold = fun acc t' -> match loop (t :: seen) t' with ODKPlain -> acc | t -> t :: acc in + let fold = fun acc (fk,t') -> match loop (fk = FromField) (t :: seen) t' with ODKPlain -> acc | t -> t :: acc in begin match List.fold_left fold [] froms with | [] -> ODKPlain (* If the abstract has no casts in the first place, we can assume plain typing (issue #10730) *) | [t] -> t @@ -801,12 +802,12 @@ and type_object_decl ctx fl with_type p = a_status = ref Closed; a_fields = PMap.empty; } - | TInst(c,tl) when Meta.has Meta.StructInit c.cl_meta -> + | TInst(c,tl) when not had_cast && Meta.has Meta.StructInit c.cl_meta -> ODKWithClass(c,tl) | _ -> ODKPlain in - loop [] t + loop false [] t | _ -> ODKPlain ) in @@ -1296,14 +1297,14 @@ and type_local_function ctx kind f with_type p = maybe_unify_ret tr | TAbstract(a,tl) -> begin match get_abstract_froms ctx a tl with - | [t2] -> + | [(_,t2)] -> if not (List.exists (shallow_eq t) stack) then loop (t :: stack) t2 | l -> (* For cases like nested EitherType, we want a flat list of all possible candidates. This might be controversial because those could be considered transitive casts, but it's unclear if that's a bad thing for this kind of inference (issue #10982). *) let rec loop stack acc l = match l with - | t :: l -> + | (_,t) :: l -> begin match follow t with | TAbstract(a,tl) as t when not (List.exists (shallow_eq t) stack) -> loop (t :: stack) acc (l @ get_abstract_froms ctx a tl) @@ -1398,15 +1399,10 @@ and type_array_decl ctx el with_type p = with Not_found -> None) | TAbstract (a,pl) as t when not (List.exists (fun t' -> shallow_eq t t') seen) -> - let types = - List.fold_left - (fun acc t' -> match loop (t :: seen) t' with - | None -> acc - | Some t -> t :: acc - ) - [] - (get_abstract_froms ctx a pl) - in + let types = List.fold_left (fun acc (_,t') -> match loop (t :: seen) t' with + | None -> acc + | Some t -> t :: acc + ) [] (get_abstract_froms ctx a pl) in (match types with | [t] -> Some t | _ -> None) diff --git a/src/typing/typerBase.ml b/src/typing/typerBase.ml index 829ad9fa104..fa7bdefb8e2 100644 --- a/src/typing/typerBase.ml +++ b/src/typing/typerBase.ml @@ -330,8 +330,12 @@ let unify_static_extension ctx e t p = e end +type from_kind = + | FromType + | FromField + let get_abstract_froms ctx a pl = - let l = List.map (apply_params a.a_params pl) a.a_from in + let l = List.map (fun t -> FromType,apply_params a.a_params pl t) 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.f.curfield then @@ -342,7 +346,7 @@ let get_abstract_froms ctx a pl = | TFun ([_,_,v],t) -> (try ignore(type_eq EqStrict t (TAbstract(a,List.map duplicate pl))); (* unify fields monomorphs *) - v :: acc + (FromField,v) :: acc with Unify_error _ -> acc) | _ -> diff --git a/tests/unit/src/unit/issues/Issue11535.hx b/tests/unit/src/unit/issues/Issue11535.hx new file mode 100644 index 00000000000..2ce98ab3245 --- /dev/null +++ b/tests/unit/src/unit/issues/Issue11535.hx @@ -0,0 +1,34 @@ +package unit.issues; + +@:structInit +private class BarImpl { + public function new() {} +} + +@:structInit +private class FooImpl { + public var x:Int; + + public function new(x:Int) { + this.x = x; + } +} + +@:forward +private abstract Foo(FooImpl) from FooImpl to FooImpl { + public function new(x:Int) { + this = new FooImpl(x); + } + + @:from + static public function fromVec4(v:BarImpl):Foo { + return new Foo(1); + } +} + +class Issue11535 extends Test { + function test() { + var v:Foo = {x: 2}; + eq(2, v.x); + } +} From eb37ceeb865d8af8f9a9cb5dadf22bb2153348e8 Mon Sep 17 00:00:00 2001 From: Rudy Ges Date: Mon, 5 Feb 2024 06:54:20 +0100 Subject: [PATCH 41/51] Skip abstract impl classes when applying addGlobalMetadata (#11546) * [typer] don't add meta to abstract impl through addGlobalMetadata * [tests] add test for #11545 --- src/typing/typeloadModule.ml | 5 +++- tests/misc/projects/Issue11545/Macro.hx | 30 +++++++++++++++++++ tests/misc/projects/Issue11545/Main.hx | 12 ++++++++ tests/misc/projects/Issue11545/compile.hxml | 2 ++ .../projects/Issue11545/compile.hxml.stdout | 3 ++ 5 files changed, 51 insertions(+), 1 deletion(-) create mode 100644 tests/misc/projects/Issue11545/Macro.hx create mode 100644 tests/misc/projects/Issue11545/Main.hx create mode 100644 tests/misc/projects/Issue11545/compile.hxml create mode 100644 tests/misc/projects/Issue11545/compile.hxml.stdout diff --git a/src/typing/typeloadModule.ml b/src/typing/typeloadModule.ml index 701dd8913ee..cc8a2c0d1a9 100644 --- a/src/typing/typeloadModule.ml +++ b/src/typing/typeloadModule.ml @@ -377,7 +377,10 @@ module TypeLevel = struct 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; + (match c.cl_kind with + | KAbstractImpl _ -> () + | _ -> 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 diff --git a/tests/misc/projects/Issue11545/Macro.hx b/tests/misc/projects/Issue11545/Macro.hx new file mode 100644 index 00000000000..e2ef32ec14b --- /dev/null +++ b/tests/misc/projects/Issue11545/Macro.hx @@ -0,0 +1,30 @@ +#if macro +import haxe.macro.Compiler; +import haxe.macro.Context; +import haxe.macro.Expr; + +class Macro { + public static function initMacro() { + Compiler.addGlobalMetadata("Main", "@:build(Macro.instrumentFields())", true, true, false); + } + + static function instrumentFields():Null> { + var fields:Array = Context.getBuildFields(); + for (field in fields) { + switch (field.kind) { + case FFun(f): + if (f.expr == null) { + continue; + } + switch (f.expr.expr) { + case EBlock(exprs): + exprs.unshift(macro trace($v{field.name})); + case _: + } + case _: + } + } + return fields; + } +} +#end diff --git a/tests/misc/projects/Issue11545/Main.hx b/tests/misc/projects/Issue11545/Main.hx new file mode 100644 index 00000000000..715e75f1b07 --- /dev/null +++ b/tests/misc/projects/Issue11545/Main.hx @@ -0,0 +1,12 @@ +class Main { + static function main() { + var name = new ImageName("abc"); + trace(name); + } +} + +abstract ImageName(String) { + public function new(name:String) { + this = name; + } +} diff --git a/tests/misc/projects/Issue11545/compile.hxml b/tests/misc/projects/Issue11545/compile.hxml new file mode 100644 index 00000000000..edb63433c3b --- /dev/null +++ b/tests/misc/projects/Issue11545/compile.hxml @@ -0,0 +1,2 @@ +--macro Macro.initMacro() +--run Main diff --git a/tests/misc/projects/Issue11545/compile.hxml.stdout b/tests/misc/projects/Issue11545/compile.hxml.stdout new file mode 100644 index 00000000000..91b293171ec --- /dev/null +++ b/tests/misc/projects/Issue11545/compile.hxml.stdout @@ -0,0 +1,3 @@ +Macro.hx:21: main +Macro.hx:21: _new +Main.hx:4: abc From 3f13b750ba4ce1bfd52983b3c2247d010cb1f176 Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Mon, 5 Feb 2024 08:23:45 +0100 Subject: [PATCH 42/51] Make ctx.pass immutable (#11538) * remove @:enumConstructorParam * remove init_class_done see if this breaks anything * clone for expr * make ctx.pass immutable * ctx.e can be immutable too * add failing test to show everyone that it's broken * fix it * inherit allow_inline and allow_transform to contexts within the same module --- src-json/meta.json | 7 ---- src/codegen/gencommon/normalize.ml | 2 +- src/context/typecore.ml | 39 ++++++++----------- src/typing/functionArguments.ml | 16 ++++---- src/typing/macroContext.ml | 28 ++++++------- src/typing/typeload.ml | 1 - src/typing/typeloadFields.ml | 19 +++++---- src/typing/typeloadFunction.ml | 3 -- src/typing/typer.ml | 26 ++++++------- src/typing/typerDisplay.ml | 1 - tests/misc/projects/Issue11538/M.hx | 3 ++ tests/misc/projects/Issue11538/Main.hx | 25 ++++++++++++ tests/misc/projects/Issue11538/compile.hxml | 2 + .../projects/Issue11538/compile.hxml.stdout | 1 + 14 files changed, 97 insertions(+), 76 deletions(-) create mode 100644 tests/misc/projects/Issue11538/M.hx create mode 100644 tests/misc/projects/Issue11538/Main.hx create mode 100644 tests/misc/projects/Issue11538/compile.hxml create mode 100644 tests/misc/projects/Issue11538/compile.hxml.stdout diff --git a/src-json/meta.json b/src-json/meta.json index 9df0fb365e6..8d5d7b9e1f6 100644 --- a/src-json/meta.json +++ b/src-json/meta.json @@ -295,13 +295,6 @@ "targets": ["TAbstract"], "links": ["https://haxe.org/manual/types-abstract-enum.html"] }, - { - "name": "EnumConstructorParam", - "metadata": ":enumConstructorParam", - "doc": "Used internally to annotate GADT type parameters.", - "targets": ["TClass"], - "internal": true - }, { "name": "Event", "metadata": ":event", diff --git a/src/codegen/gencommon/normalize.ml b/src/codegen/gencommon/normalize.ml index 2758423ef55..5072a609734 100644 --- a/src/codegen/gencommon/normalize.ml +++ b/src/codegen/gencommon/normalize.ml @@ -31,7 +31,7 @@ open Gencommon let rec filter_param (stack:t list) t = match t with - | TInst({ cl_kind = KTypeParameter _ } as c,_) when Meta.has Meta.EnumConstructorParam c.cl_meta -> + | TInst({ cl_kind = KTypeParameter ttp },_) when ttp.ttp_host = TPHEnumConstructor -> t_dynamic | TMono r -> (match r.tm_type with diff --git a/src/context/typecore.ml b/src/context/typecore.ml index 730c05259b8..b0db1b0ff73 100644 --- a/src/context/typecore.ml +++ b/src/context/typecore.ml @@ -169,8 +169,8 @@ and typer = { mutable m : typer_module; c : typer_class; f : typer_field; - mutable e : typer_expr; - mutable pass : typer_pass; + e : typer_expr; + pass : typer_pass; mutable type_params : type_params; mutable allow_inline : bool; mutable allow_transform : bool; @@ -183,7 +183,7 @@ and monomorphs = { } module TyperManager = struct - let create com g m c f e pass params = { + let create com g m c f e pass params allow_inline allow_transform = { com = com; g = g; t = com.basic; @@ -192,8 +192,8 @@ module TyperManager = struct f = f; e = e; pass = pass; - allow_inline = true; - allow_transform = true; + allow_inline; + allow_transform; type_params = params; memory_marker = memory_marker; } @@ -244,42 +244,46 @@ module TyperManager = struct 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 [] + create com g m c f e PBuildModule [] true true 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 + create ctx.com ctx.g ctx.m c f e PBuildClass params ctx.allow_inline ctx.allow_transform 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 + create ctx.com ctx.g ctx.m c f e PBuildModule en.e_params ctx.allow_inline ctx.allow_transform 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 + create ctx.com ctx.g ctx.m c f e PBuildModule td.t_params ctx.allow_inline ctx.allow_transform 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 + create ctx.com ctx.g ctx.m c f e PBuildModule a.a_params ctx.allow_inline ctx.allow_transform 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 + create ctx.com ctx.g ctx.m ctx.c f e PBuildClass params ctx.allow_inline ctx.allow_transform 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 + create ctx.com ctx.g ctx.m ctx.c f e PBuildClass params ctx.allow_inline ctx.allow_transform + + let clone_for_expr ctx = + let e = create_ctx_e () in + create ctx.com ctx.g ctx.m ctx.c ctx.f e PTypeField ctx.type_params ctx.allow_inline ctx.allow_transform end type field_host = @@ -559,12 +563,8 @@ let rec flush_pass ctx p where = let make_pass ctx f = f -let init_class_done ctx = - ctx.pass <- PConnectField - let enter_field_typing_pass ctx info = - flush_pass ctx PConnectField info; - ctx.pass <- PTypeField + flush_pass ctx PConnectField info let make_lazy ?(force=true) ctx t_proc f where = let r = ref (lazy_available t_dynamic) in @@ -909,11 +909,6 @@ let debug com (path : string list) str = if List.exists (Ast.match_path false path) debug_paths then emit(); end -let init_class_done ctx = - 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.c.curclass.cl_path with "" -> inf | n when n = snd ctx.m.curmod.m_path -> inf | n -> inf @ [n]) in diff --git a/src/typing/functionArguments.ml b/src/typing/functionArguments.ml index cba9c2add66..f7251a69ca3 100644 --- a/src/typing/functionArguments.ml +++ b/src/typing/functionArguments.ml @@ -4,7 +4,7 @@ open Type open Typecore open Error -let type_function_arg ctx t e opt p = +let type_function_arg com t e opt p = (* TODO https://github.com/HaxeFoundation/haxe/issues/8461 *) (* delay ctx PTypeField (fun() -> if ExtType.is_void (follow t) then @@ -12,9 +12,9 @@ let type_function_arg ctx t e opt p = ); *) if opt then let e = (match e with None -> Some (EConst (Ident "null"),null_pos) | _ -> e) in - ctx.t.tnull t, e + com.Common.basic.tnull t, e else - let t = match e with Some (EConst (Ident "null"),null_pos) -> ctx.t.tnull t | _ -> t in + let t = match e with Some (EConst (Ident "null"),null_pos) -> com.basic.tnull t | _ -> t in t, e let type_function_arg_value ctx t c do_display = @@ -38,7 +38,7 @@ let type_function_arg_value ctx t c do_display = loop e class function_arguments - (ctx : typer) + (com : Common.context) (type_arg : int -> bool -> type_hint option -> pos -> Type.t) (is_extern : bool) (do_display : bool) @@ -48,7 +48,7 @@ class function_arguments let with_default = let l = List.mapi (fun i ((name,pn),opt,_,t,eo) -> let t = type_arg i opt t pn in - let t,eo = type_function_arg ctx t eo opt pn in + let t,eo = type_function_arg com t eo opt pn in (name,eo,t) ) syntax in let l = match abstract_this with @@ -83,7 +83,7 @@ object(self) (* Returns the `(tvar * texpr option) list` for `tf_args`. Also checks the validity of argument names and whether or not an argument should be displayed. *) - method for_expr = match expr_repr with + method for_expr ctx = match expr_repr with | Some l -> l | None -> @@ -116,7 +116,7 @@ object(self) l (* Verifies the validity of any argument typed as `haxe.extern.Rest` and checks default values. *) - method verify_extern = + method verify_extern ctx = let rec loop is_abstract_this syntax typed = match syntax,typed with | syntax,(name,_,t) :: typed when is_abstract_this -> loop false syntax typed @@ -135,5 +135,5 @@ object(self) method bring_into_context ctx = List.iter (fun (v,_) -> ctx.f.locals <- PMap.add v.v_name v ctx.f.locals - ) self#for_expr + ) (self#for_expr ctx) end diff --git a/src/typing/macroContext.ml b/src/typing/macroContext.ml index b17f1a2b103..225c211339d 100644 --- a/src/typing/macroContext.ml +++ b/src/typing/macroContext.ml @@ -57,7 +57,7 @@ let macro_timer com l = 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.f.locals in + let old = ctx.com.error_ext 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) @@ -65,18 +65,20 @@ let typing_timer ctx need_type f = (* if ctx.com.display.dms_kind = DMNone then ctx.com.error <- (fun e -> raise_error e); *) (* TODO: review this... *) ctx.com.error_ext <- (fun err -> raise_error { err with err_from_macro = true }); - if need_type && ctx.pass < PTypeField then begin + let ctx = if need_type && ctx.pass < PTypeField then begin enter_field_typing_pass ctx ("typing_timer",[] (* TODO: ? *)); - end; + TyperManager.clone_for_expr ctx + end else + ctx + in let exit() = t(); ctx.com.error_ext <- old; - ctx.pass <- oldp; ctx.f.locals <- oldlocals; restore_report_mode (); in try - let r = f() in + let r = f ctx in exit(); r with Error err -> @@ -322,7 +324,7 @@ let make_macro_api ctx mctx p = { com_api with MacroApi.get_type = (fun s -> - typing_timer ctx false (fun() -> + typing_timer ctx false (fun ctx -> let path = parse_path s in let tp = match List.rev (fst path) with | s :: sl when String.length s > 0 && (match s.[0] with 'A'..'Z' -> true | _ -> false) -> @@ -338,10 +340,10 @@ let make_macro_api ctx mctx p = ) ); MacroApi.resolve_type = (fun t p -> - typing_timer ctx false (fun() -> Typeload.load_complex_type ctx false (t,p)) + typing_timer ctx false (fun ctx -> Typeload.load_complex_type ctx false (t,p)) ); MacroApi.resolve_complex_type = (fun t -> - typing_timer ctx false (fun() -> + typing_timer ctx false (fun ctx -> let rec load (t,_) = ((match t with | CTPath ptp -> @@ -394,17 +396,17 @@ let make_macro_api ctx mctx p = ) ); MacroApi.get_module = (fun s -> - typing_timer ctx false (fun() -> + typing_timer ctx false (fun ctx -> let path = parse_path s in let m = List.map type_of_module_type (TypeloadModule.load_module ctx path p).m_types in m ) ); MacroApi.type_expr = (fun e -> - typing_timer ctx true (fun() -> type_expr ctx e WithType.value) + typing_timer ctx true (fun ctx -> type_expr ctx e WithType.value) ); MacroApi.flush_context = (fun f -> - typing_timer ctx true f + typing_timer ctx true (fun _ -> f ()) ); MacroApi.get_local_type = (fun() -> match ctx.c.get_build_infos() with @@ -500,7 +502,7 @@ let make_macro_api ctx mctx p = end ); MacroApi.module_dependency = (fun mpath file -> - let m = typing_timer ctx false (fun() -> + let m = typing_timer ctx false (fun ctx -> let old_deps = ctx.m.curmod.m_extra.m_deps in let m = TypeloadModule.load_module ctx (parse_path mpath) p in ctx.m.curmod.m_extra.m_deps <- old_deps; @@ -512,7 +514,7 @@ let make_macro_api ctx mctx p = ctx.m.curmod ); MacroApi.cast_or_unify = (fun t e p -> - typing_timer ctx true (fun () -> + typing_timer ctx true (fun ctx -> try ignore(AbstractCast.cast_or_unify_raise ctx t e p); true diff --git a/src/typing/typeload.ml b/src/typing/typeload.ml index 7bc27105321..bfba81c88ac 100644 --- a/src/typing/typeload.ml +++ b/src/typing/typeload.ml @@ -726,7 +726,6 @@ let rec type_type_param ctx host path p tp = 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 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 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); diff --git a/src/typing/typeloadFields.ml b/src/typing/typeloadFields.ml index f49140384ff..200470095e2 100644 --- a/src/typing/typeloadFields.ml +++ b/src/typing/typeloadFields.ml @@ -740,10 +740,11 @@ module TypeBinding = struct display_error ctx.com ("Redefinition of variable " ^ cf.cf_name ^ " in subclass is not allowed. Previously declared at " ^ (s_type_path csup.cl_path) ) cf.cf_name_pos end - let bind_var_expression ctx cctx fctx cf e = + let bind_var_expression ctx_f cctx fctx cf e = let c = cctx.tclass in let t = cf.cf_type in let p = cf.cf_pos in + let ctx = TyperManager.clone_for_expr ctx_f in if (has_class_flag c CInterface) then unexpected_expression ctx.com fctx "Initialization on field of interface" (pos e); cf.cf_meta <- ((Meta.Value,[e],null_pos) :: cf.cf_meta); let check_cast e = @@ -834,8 +835,9 @@ module TypeBinding = struct | Some e -> bind_var_expression ctx cctx fctx cf e - let bind_method ctx cctx fctx cf t args ret e p = + let bind_method ctx_f cctx fctx cf t args ret e p = let c = cctx.tclass in + let ctx = TyperManager.clone_for_expr ctx_f in let bind r = incr stats.s_methods_typed; if (Meta.has (Meta.Custom ":debug.typing") (c.cl_meta @ cf.cf_meta)) then ctx.com.print (Printf.sprintf "Typing method %s.%s\n" (s_type_path c.cl_path) cf.cf_name); @@ -875,7 +877,7 @@ module TypeBinding = struct if v.v_name <> "_" && has_mono v.v_type then warning ctx WTemp "Uninferred function argument, please add a type-hint" v.v_pos; ) fargs; *) let tf = { - tf_args = args#for_expr; + tf_args = args#for_expr ctx; tf_type = ret; tf_expr = e; } in @@ -1192,7 +1194,7 @@ let setup_args_ret ctx cctx fctx name fd p = in if i = 0 then maybe_use_property_type cto (fun () -> match Lazy.force mk with MKSetter -> true | _ -> false) def else def() in - let args = new FunctionArguments.function_arguments ctx type_arg is_extern fctx.is_display_field abstract_this fd.f_args in + let args = new FunctionArguments.function_arguments ctx.com type_arg is_extern fctx.is_display_field abstract_this fd.f_args in args,ret let create_method (ctx,cctx,fctx) c f fd p = @@ -1346,11 +1348,15 @@ let create_method (ctx,cctx,fctx) c f fd p = if fctx.is_display_field then begin delay ctx PTypeField (fun () -> (* We never enter type_function so we're missing out on the argument processing there. Let's do it here. *) - ignore(args#for_expr) + let ctx = TyperManager.clone_for_expr ctx in + ignore(args#for_expr ctx) ); check_field_display ctx fctx c cf; end else - delay ctx PTypeField (fun () -> args#verify_extern); + delay ctx PTypeField (fun () -> + let ctx = TyperManager.clone_for_expr ctx in + args#verify_extern ctx + ); if fd.f_expr <> None then begin if fctx.is_abstract then unexpected_expression ctx.com fctx "Abstract methods may not have an expression" p else if not (fctx.is_inline || fctx.is_macro) then warning ctx WExternWithExpr "Extern non-inline function may not have an expression" p; @@ -1608,7 +1614,6 @@ let check_overloads ctx c = 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; (match r with | None -> () | Some r -> delay ctx PTypeField (fun() -> ignore(lazy_type r))) diff --git a/src/typing/typeloadFunction.ml b/src/typing/typeloadFunction.ml index d3dff29cd54..9e8b073b3c6 100644 --- a/src/typing/typeloadFunction.ml +++ b/src/typing/typeloadFunction.ml @@ -28,12 +28,9 @@ open Error open FunctionArguments let save_field_state ctx = - let old_e = ctx.e in - ctx.e <- TyperManager.create_ctx_e (); let locals = ctx.f.locals in (fun () -> ctx.f.locals <- locals; - ctx.e <- old_e; ) let type_function_params ctx fd host fname p = diff --git a/src/typing/typer.ml b/src/typing/typer.ml index 57778ec4f16..25e48f28733 100644 --- a/src/typing/typer.ml +++ b/src/typing/typer.ml @@ -1217,23 +1217,30 @@ and type_map_declaration ctx e1 el with_type p = let el = (mk (TVar (v,Some enew)) t_dynamic p) :: (List.rev el) in mk (TBlock el) tmap p -and type_local_function ctx kind f with_type p = +and type_local_function ctx_from kind f with_type p = let name,inline = match kind with FKNamed (name,inline) -> Some name,inline | _ -> None,false in - let params = TypeloadFunction.type_function_params ctx f TPHLocal (match name with None -> "localfun" | Some (n,_) -> n) p in + let params = TypeloadFunction.type_function_params ctx_from f TPHLocal (match name with None -> "localfun" | Some (n,_) -> n) p in if params <> [] then begin - if name = None then display_error ctx.com "Type parameters not supported in unnamed local functions" p; + if name = None then display_error ctx_from.com "Type parameters not supported in unnamed local functions" p; if with_type <> WithType.NoValue then raise_typing_error "Type parameters are not supported for rvalue functions" p end; let v,pname = (match name with | None -> None,p | Some (v,pn) -> Some v,pn ) in - let old_tp,old_in_loop = ctx.type_params,ctx.e.in_loop in + let curfun = match ctx_from.e.curfun with + | FunStatic -> FunStatic + | FunMemberAbstract + | FunMemberAbstractLocal -> FunMemberAbstractLocal + | _ -> FunMemberClassLocal + in + let ctx = TyperManager.clone_for_expr ctx_from in + let old_tp = ctx.type_params in ctx.type_params <- params @ ctx.type_params; 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.f.in_display None f.f_args in + let args = new FunctionArguments.function_arguments ctx.com 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 @@ -1331,17 +1338,10 @@ 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.e.curfun with - | FunStatic -> FunStatic - | FunMemberAbstract - | FunMemberAbstractLocal -> FunMemberAbstractLocal - | _ -> FunMemberClassLocal - 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.e.in_loop <- old_in_loop; let tf = { - tf_args = args#for_expr; + tf_args = args#for_expr ctx; tf_type = rt; tf_expr = e; } in diff --git a/src/typing/typerDisplay.ml b/src/typing/typerDisplay.ml index 9470e8bae60..7734c359d90 100644 --- a/src/typing/typerDisplay.ml +++ b/src/typing/typerDisplay.ml @@ -583,7 +583,6 @@ let handle_display ctx e_ast dk mode with_type = raise_toplevel ctx dk with_type (s_type_path path,p) | DisplayException(DisplayFields ({fkind = CRTypeHint} as r)) when (match fst e_ast with ENew _ -> true | _ -> false) -> let timer = Timer.timer ["display";"toplevel";"filter ctors"] in - ctx.pass <- PBuildClass; let l = List.filter (fun item -> let is_private_to_current_module mt = (* Remove the _Module nonsense from the package *) diff --git a/tests/misc/projects/Issue11538/M.hx b/tests/misc/projects/Issue11538/M.hx new file mode 100644 index 00000000000..e9d9ac1c27a --- /dev/null +++ b/tests/misc/projects/Issue11538/M.hx @@ -0,0 +1,3 @@ +class M { + static public var x:Float; +} diff --git a/tests/misc/projects/Issue11538/Main.hx b/tests/misc/projects/Issue11538/Main.hx new file mode 100644 index 00000000000..58d58e3cb93 --- /dev/null +++ b/tests/misc/projects/Issue11538/Main.hx @@ -0,0 +1,25 @@ +import haxe.macro.Context; +import haxe.macro.Expr; + +using haxe.macro.Tools; + +#if !macro +@:build(Main.build()) +#end +class Main { + #if macro + static function build():Array { + var t = Context.typeof(macro M.x); + var field = (macro class X { + static public var type = $v{t.toString()}; + }).fields[0]; + return [field]; + } + #end +} + +function main() { + #if !macro + trace(Main.type); + #end +} diff --git a/tests/misc/projects/Issue11538/compile.hxml b/tests/misc/projects/Issue11538/compile.hxml new file mode 100644 index 00000000000..b30a755894b --- /dev/null +++ b/tests/misc/projects/Issue11538/compile.hxml @@ -0,0 +1,2 @@ +--main Main +--interp \ No newline at end of file diff --git a/tests/misc/projects/Issue11538/compile.hxml.stdout b/tests/misc/projects/Issue11538/compile.hxml.stdout new file mode 100644 index 00000000000..b41a42411d0 --- /dev/null +++ b/tests/misc/projects/Issue11538/compile.hxml.stdout @@ -0,0 +1 @@ +Main.hx:23: Float \ No newline at end of file From a10790a4e22d5a3ce9d5726f32ec6aa5ca6a10d7 Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Mon, 5 Feb 2024 10:03:35 +0100 Subject: [PATCH 43/51] Typer cleanup continued (#11548) * remove @:enumConstructorParam * remove init_class_done see if this breaks anything * clone for expr * make ctx.pass immutable * ctx.e can be immutable too * add failing test to show everyone that it's broken * fix it * only need g for delays * lose server dependency on typer * evacuate some things from typecore.ml * small cleanup * add g.root_typer This gives us a nice context tree structure * remove more { ctx with and assert order * less mutability and cloning * even less cloning * fix allow_inline again --- src/compiler/displayProcessing.ml | 4 +- src/compiler/server.ml | 80 ++++---- src/context/display/displayEmitter.ml | 2 +- src/context/display/displayTexpr.ml | 6 +- src/context/display/importHandling.ml | 2 +- src/context/display/syntaxExplorer.ml | 2 +- src/context/typecore.ml | 261 +++++++------------------- src/core/naming.ml | 53 ++++++ src/typing/finalization.ml | 4 +- src/typing/functionArguments.ml | 6 +- src/typing/generic.ml | 19 +- src/typing/instanceBuilder.ml | 2 +- src/typing/macroContext.ml | 21 +-- src/typing/strictMeta.ml | 36 +++- src/typing/typeload.ml | 21 ++- src/typing/typeloadCacheHook.ml | 31 +++ src/typing/typeloadCheck.ml | 40 ++-- src/typing/typeloadFields.ml | 78 ++++---- src/typing/typeloadFunction.ml | 18 +- src/typing/typeloadModule.ml | 101 +++++----- src/typing/typeloadParse.ml | 8 +- src/typing/typer.ml | 6 +- src/typing/typerEntry.ml | 5 +- 23 files changed, 400 insertions(+), 406 deletions(-) create mode 100644 src/typing/typeloadCacheHook.ml diff --git a/src/compiler/displayProcessing.ml b/src/compiler/displayProcessing.ml index d2dde9cef58..7e345a0f8e6 100644 --- a/src/compiler/displayProcessing.ml +++ b/src/compiler/displayProcessing.ml @@ -239,7 +239,7 @@ let load_display_file_standalone (ctx : Typecore.typer) file = let dir = ExtString.String.join (if path.backslash then "\\" else "/") parts in 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) + ignore(TypeloadModule.type_module ctx.com ctx.g (pack,name) file ~dont_check_path:true decls null_pos) let load_display_content_standalone (ctx : Typecore.typer) input = let com = ctx.com in @@ -247,7 +247,7 @@ let load_display_content_standalone (ctx : Typecore.typer) input = let p = {pfile = file; pmin = 0; pmax = 0} in let parsed = TypeloadParse.parse_file_from_string com file p input in let pack,decls = TypeloadParse.handle_parser_result com p parsed in - ignore(TypeloadModule.type_module ctx (pack,"?DISPLAY") file ~dont_check_path:true decls p) + ignore(TypeloadModule.type_module ctx.com ctx.g (pack,"?DISPLAY") file ~dont_check_path:true decls p) (* 4. Display processing before typing *) diff --git a/src/compiler/server.ml b/src/compiler/server.ml index e664d8691a7..62629092446 100644 --- a/src/compiler/server.ml +++ b/src/compiler/server.ml @@ -3,13 +3,13 @@ open Common open CompilationCache open Timer open Type -open Typecore open DisplayProcessingGlobals open Ipaddr open Json open CompilationContext open MessageReporting open HxbData +open TypeloadCacheHook exception Dirty of module_skip_reason exception ServerError of string @@ -162,10 +162,9 @@ let stat dir = (Unix.stat (Path.remove_trailing_slash dir)).Unix.st_mtime (* Gets a list of changed directories for the current compilation. *) -let get_changed_directories sctx (ctx : Typecore.typer) = +let get_changed_directories sctx com = let t = Timer.timer ["server";"module cache";"changed dirs"] in let cs = sctx.cs in - let com = ctx.Typecore.com in let sign = Define.get_signature com.defines in let dirs = try (* First, check if we already have determined changed directories for current compilation. *) @@ -229,16 +228,15 @@ 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_path m_extra p = - let com = ctx.Typecore.com in +let check_module sctx com m_path m_extra p = let cc = CommonCache.get_cache com in let content_changed m_path file = - let fkey = ctx.com.file_keys#get file in + let fkey = 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_path p in + let new_data = TypeloadParse.parse_module com m_path p in cfile.c_decls <> snd new_data with Not_found -> true @@ -259,7 +257,7 @@ let check_module sctx ctx m_path m_extra p = let unknown_state_modules = ref [] in let rec check m_path m_extra = let check_module_path () = - let directories = get_changed_directories sctx ctx in + let directories = get_changed_directories sctx com in match m_extra.m_kind with | MFake | MImport -> () (* don't get classpath *) | MExtern -> @@ -285,18 +283,12 @@ let check_module sctx ctx m_path m_extra p = | MMacro when com.is_macro_context -> 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. - Most likely because of circular dependencies in base modules (e.g. `StdTypes` or `String`) - Prevents spending another 5 hours for debugging. - @see https://github.com/HaxeFoundation/haxe/issues/8174 - *) - if not ctx.g.complete && ctx.com.is_macro_context then - raise (ServerError ("Infinite loop in Haxe server detected. " - ^ "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_path m_extra + begin match com.get_macros() with + | None -> + () + | Some mcom -> + check_module_shadowing (get_changed_directories sctx mcom) m_path m_extra + end in 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 @@ -309,7 +301,7 @@ let check_module sctx ctx m_path m_extra p = ServerMessage.unchanged_content com "" file; end else begin 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); + if m_extra.m_kind = MFake then Hashtbl.remove fake_modules (Path.UniqueKey.lazy_key m_extra.m_file); raise (Dirty (FileChanged file)) end end @@ -395,7 +387,7 @@ let check_module sctx ctx m_path m_extra p = state class hxb_reader_api_server - (ctx : Typecore.typer) + (com : Common.context) (cc : context_cache) = object(self) @@ -410,7 +402,7 @@ class hxb_reader_api_server } method add_module (m : module_def) = - ctx.com.module_lut#add m.m_path m + com.module_lut#add m.m_path m method resolve_type (pack : string list) (mname : string) (tname : string) = let path = (pack,mname) in @@ -422,7 +414,7 @@ class hxb_reader_api_server | GoodModule m -> m | BinaryModule mc -> - let reader = new HxbReader.hxb_reader path ctx.com.hxb_reader_stats in + let reader = new HxbReader.hxb_reader path 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 @@ -434,7 +426,7 @@ class hxb_reader_api_server (* 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); + if is_display_file || 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__ @@ -443,7 +435,7 @@ class hxb_reader_api_server method find_module (m_path : path) = try - GoodModule (ctx.com.module_lut#find m_path) + GoodModule (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 @@ -454,13 +446,13 @@ class hxb_reader_api_server NoModule method basic_types = - ctx.com.basic + com.basic method get_var_id (i : int) = i method read_expression_eagerly (cf : tclass_field) = - ctx.com.display.dms_full_typing + com.display.dms_full_typing end let handle_cache_bound_objects com cbol = @@ -475,12 +467,11 @@ let handle_cache_bound_objects com cbol = (* Adds module [m] and all its dependencies (recursively) from the cache to the current compilation context. *) -let rec add_modules sctx ctx (m : module_def) (from_binary : bool) (p : pos) = - let com = ctx.Typecore.com in +let rec add_modules sctx com (m : module_def) (from_binary : bool) (p : pos) = 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; + if m.m_extra.m_added < com.compilation_step then begin + m.m_extra.m_added <- 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 *) @@ -501,7 +492,7 @@ let rec add_modules sctx ctx (m : module_def) (from_binary : bool) (p : pos) = let m2 = try com.module_lut#find mpath with Not_found -> - match type_module sctx ctx mpath p with + match type_module sctx com mpath p with | GoodModule m -> m | BinaryModule mc -> @@ -521,9 +512,8 @@ let rec add_modules sctx ctx (m : module_def) (from_binary : bool) (p : pos) = (* 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. *) -and type_module sctx (ctx:Typecore.typer) mpath p = +and type_module sctx com mpath p = let t = Timer.timer ["server";"module cache"] in - let com = ctx.Typecore.com in let cc = CommonCache.get_cache com in let skip m_path reason = ServerMessage.skipping_dep com "" (m_path,(Printer.s_module_skip_reason reason)); @@ -531,17 +521,17 @@ and type_module sctx (ctx:Typecore.typer) mpath p = in let add_modules from_binary m = let tadd = Timer.timer ["server";"module cache";"add modules"] in - add_modules sctx ctx m from_binary p; + add_modules sctx com m from_binary p; tadd(); GoodModule m in - let check_module sctx ctx m_path m_extra p = + let check_module sctx 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 + let r = check_module sctx com mpath m_extra p in tcheck(); r in - let find_module_in_cache ctx cc m_path p = + let find_module_in_cache cc m_path p = try let m = cc#find_module m_path in begin match m.m_extra.m_cache_state with @@ -558,11 +548,11 @@ and type_module sctx (ctx:Typecore.typer) mpath p = NoModule in (* Should not raise anything! *) - let m = match find_module_in_cache ctx cc mpath p with + let m = match find_module_in_cache 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 + begin match check_module sctx mpath m.m_extra p with | None -> add_modules false m; | Some reason -> @@ -571,10 +561,10 @@ and type_module sctx (ctx:Typecore.typer) mpath p = | 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 + begin match check_module sctx 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 api = (new hxb_reader_api_server com 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 @@ -585,7 +575,7 @@ and type_module sctx (ctx:Typecore.typer) mpath p = (* 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); + if is_display_file || com.display.dms_full_typing then ignore(f_next chunks EOM); add_modules true m; | Some reason -> skip mpath reason @@ -759,7 +749,7 @@ let do_connect ip port args = if !has_error then exit 1 let enable_cache_mode sctx = - TypeloadModule.type_module_hook := type_module sctx; + type_module_hook := type_module sctx; ServerCompilationContext.ensure_macro_setup sctx; TypeloadParse.parse_hook := parse_file sctx.cs diff --git a/src/context/display/displayEmitter.ml b/src/context/display/displayEmitter.ml index 58b50c7d25f..2b8e7d0fc1b 100644 --- a/src/context/display/displayEmitter.ml +++ b/src/context/display/displayEmitter.ml @@ -169,7 +169,7 @@ let check_display_metadata ctx meta = List.iter (fun e -> if display_position#enclosed_in (pos e) then begin let e = preprocess_expr ctx.com e in - delay ctx PTypeField (fun _ -> ignore(type_expr ctx e WithType.value)); + delay ctx.g PTypeField (fun _ -> ignore(type_expr ctx e WithType.value)); end ) args ) meta diff --git a/src/context/display/displayTexpr.ml b/src/context/display/displayTexpr.ml index 777ba93ef24..bdd8e72b7a4 100644 --- a/src/context/display/displayTexpr.ml +++ b/src/context/display/displayTexpr.ml @@ -63,7 +63,7 @@ let actually_check_display_field ctx c cff p = let display_modifier = Typeload.check_field_access ctx cff in let fctx = TypeloadFields.create_field_context ctx cctx cff true display_modifier in let cf = TypeloadFields.init_field (ctx,cctx,fctx) cff in - flush_pass ctx PTypeField ("check_display_field",(fst c.cl_path @ [snd c.cl_path;fst cff.cff_name])); + flush_pass ctx.g PTypeField ("check_display_field",(fst c.cl_path @ [snd c.cl_path;fst cff.cff_name])); ignore(follow cf.cf_type) let check_display_field ctx sc c cf = @@ -173,10 +173,10 @@ let check_display_file ctx cs = let m = try ctx.com.module_lut#find path with Not_found -> - begin match !TypeloadModule.type_module_hook ctx path null_pos with + begin match !TypeloadCacheHook.type_module_hook ctx.com 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 api = (new TypeloadModule.hxb_reader_api_typeload ctx.com ctx.g 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 diff --git a/src/context/display/importHandling.ml b/src/context/display/importHandling.ml index 69a9e9f16c3..d0ac35235ff 100644 --- a/src/context/display/importHandling.ml +++ b/src/context/display/importHandling.ml @@ -296,4 +296,4 @@ let init_using ctx path p = ctx.m.import_resolution#add (module_type_resolution mt None p) ) (List.rev types); (* delay the using since we need to resolve typedefs *) - delay_late ctx PConnectField (fun () -> ctx.m.module_using <- filter_classes types @ ctx.m.module_using) + delay_late ctx.g PConnectField (fun () -> ctx.m.module_using <- filter_classes types @ ctx.m.module_using) diff --git a/src/context/display/syntaxExplorer.ml b/src/context/display/syntaxExplorer.ml index bc6c1328cc3..2a7b2bd4978 100644 --- a/src/context/display/syntaxExplorer.ml +++ b/src/context/display/syntaxExplorer.ml @@ -177,7 +177,7 @@ let explore_uncached_modules tctx cs symbols = begin try let m = tctx.g.do_load_module tctx (cfile.c_package,module_name) null_pos in (* We have to flush immediately so we catch exceptions from weird modules *) - Typecore.flush_pass tctx Typecore.PFinal ("final",cfile.c_package @ [module_name]); + Typecore.flush_pass tctx.g Typecore.PFinal ("final",cfile.c_package @ [module_name]); m :: acc with _ -> acc diff --git a/src/context/typecore.ml b/src/context/typecore.ml index b0db1b0ff73..a530d735fe5 100644 --- a/src/context/typecore.ml +++ b/src/context/typecore.ml @@ -125,6 +125,7 @@ type typer_globals = { mutable build_count : int; mutable t_dynamic_def : Type.t; mutable delayed_display : DisplayTypes.display_exception_kind option; + root_typer : typer; (* 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); @@ -138,11 +139,11 @@ type typer_globals = { (* typer_expr holds information that is specific to a (function) expresssion, whereas typer_field is shared by local TFunctions. *) and typer_expr = { + curfun : current_fun; + in_function : bool; 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; @@ -182,21 +183,33 @@ and monomorphs = { mutable perfunction : (tmono * pos) list; } +let pass_name = function + | PBuildModule -> "build-module" + | PBuildClass -> "build-class" + | PConnectField -> "connect-field" + | PTypeField -> "type-field" + | PCheckConstraint -> "check-constraint" + | PForce -> "force" + | PFinal -> "final" + module TyperManager = struct - let create com g m c f e pass params allow_inline allow_transform = { - com = com; - g = g; - t = com.basic; - m = m; - c = c; - f = f; - e = e; - pass = pass; - allow_inline; - allow_transform; - type_params = params; - memory_marker = memory_marker; - } + let create ctx m c f e pass params = + if pass < ctx.pass then die (Printf.sprintf "Bad context clone from %s(%s) to %s(%s)" (s_type_path ctx.m.curmod.m_path) (pass_name ctx.pass) (s_type_path m.curmod.m_path) (pass_name pass)) __LOC__; + let new_ctx = { + com = ctx.com; + g = ctx.g; + t = ctx.com.basic; + m = m; + c = c; + f = f; + e = e; + pass = pass; + allow_inline = ctx.allow_inline; + allow_transform = ctx.allow_transform; + type_params = params; + memory_marker = memory_marker; + } in + new_ctx let create_ctx_c c = { @@ -224,12 +237,12 @@ module TyperManager = struct in_call_args = false; } - let create_ctx_e () = + let create_ctx_e curfun in_function = { + curfun; + in_function; ret = t_dynamic; - curfun = FunStatic; opened = []; - in_function = false; monomorphs = { perfunction = []; }; @@ -240,50 +253,48 @@ module TyperManager = struct 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 [] true true + let clone_for_module ctx m = + let ctx = create ctx m ctx.c ctx.f ctx.e PBuildModule [] in + ctx.allow_transform <- true; + ctx.allow_inline <- true; + ctx 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 ctx.allow_inline ctx.allow_transform + create ctx ctx.m c ctx.f ctx.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 ctx.allow_inline ctx.allow_transform + create ctx ctx.m c ctx.f ctx.e PBuildClass 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 ctx.allow_inline ctx.allow_transform + create ctx ctx.m c ctx.f ctx.e PBuildClass 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 ctx.allow_inline ctx.allow_transform + create ctx ctx.m c ctx.f ctx.e PBuildClass 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 ctx.allow_inline ctx.allow_transform + create ctx ctx.m ctx.c f ctx.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 ctx.allow_inline ctx.allow_transform + create ctx ctx.m ctx.c f ctx.e PBuildClass params + + let clone_for_expr ctx curfun in_function = + let e = create_ctx_e curfun in_function in + create ctx ctx.m ctx.c ctx.f e PTypeField ctx.type_params + + let clone_for_type_params ctx params = + create ctx ctx.m ctx.c ctx.f ctx.e ctx.pass params - let clone_for_expr ctx = - let e = create_ctx_e () in - create ctx.com ctx.g ctx.m ctx.c ctx.f e PTypeField ctx.type_params ctx.allow_inline ctx.allow_transform + let clone_for_type_parameter_expression ctx = + let f = create_ctx_f ctx.f.curfield in + let e = create_ctx_e ctx.e.curfun false in + create ctx ctx.m ctx.c f e PTypeField ctx.type_params end type field_host = @@ -323,13 +334,6 @@ type dot_path_part = { case : dot_path_part_case; 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; @@ -355,15 +359,6 @@ let type_generic_function_ref : (typer -> field_access -> (unit -> texpr) field_ let create_context_ref : (Common.context -> ((unit -> unit) * typer) option -> typer) ref = ref (fun _ -> assert false) -let pass_name = function - | PBuildModule -> "build-module" - | PBuildClass -> "build-class" - | PConnectField -> "connect-field" - | PTypeField -> "type-field" - | PCheckConstraint -> "check-constraint" - | PForce -> "force" - | PFinal -> "final" - let warning ?(depth=0) ctx w msg p = 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 @@ -456,58 +451,8 @@ let add_local ctx k n t p = ctx.f.locals <- PMap.add n v ctx.f.locals; v -let display_identifier_error ctx ?prepend_msg msg p = - let prepend = match prepend_msg with Some s -> s ^ " " | _ -> "" in - display_error ctx.com (prepend ^ msg) p - -let check_identifier_name ?prepend_msg ctx name kind p = - if starts_with name '$' then - display_identifier_error ctx ?prepend_msg ((StringHelper.capitalize kind) ^ " names starting with a dollar are not allowed: \"" ^ name ^ "\"") p - else if not (Lexer.is_valid_identifier name) then - display_identifier_error ctx ?prepend_msg ("\"" ^ (StringHelper.s_escape name) ^ "\" is not a valid " ^ kind ^ " name.") p - -let check_field_name ctx name p = - match name with - | "new" -> () (* the only keyword allowed in field names *) - | _ -> check_identifier_name ctx name "field" p - -let check_uppercase_identifier_name ?prepend_msg ctx name kind p = - if String.length name = 0 then - display_identifier_error ?prepend_msg ctx ((StringHelper.capitalize kind) ^ " name must not be empty.") p - else if Ast.is_lower_ident name then - display_identifier_error ?prepend_msg ctx ((StringHelper.capitalize kind) ^ " name should start with an uppercase letter: \"" ^ name ^ "\"") p - else - check_identifier_name ?prepend_msg ctx name kind p - -let check_module_path ctx (pack,name) p = - let full_path = StringHelper.s_escape (if pack = [] then name else (String.concat "." pack) ^ "." ^ name) in - check_uppercase_identifier_name ~prepend_msg:("Module \"" ^ full_path ^ "\" does not have a valid name.") ctx name "module" p; - try - List.iter (fun part -> Path.check_package_name part) pack; - with Failure msg -> - display_error_ext ctx.com (make_error - ~sub:[make_error (Custom msg) p] - (Custom ("\"" ^ (StringHelper.s_escape (String.concat "." pack)) ^ "\" is not a valid package name:")) - p - ) - -let check_local_variable_name ctx name origin p = - match name with - | "this" -> () (* TODO: vars named `this` should technically be VGenerated, not VUser *) - | _ -> - let s_var_origin origin = - match origin with - | TVOLocalVariable -> "variable" - | TVOArgument -> "function argument" - | TVOForVariable -> "for variable" - | TVOPatternVariable -> "pattern variable" - | TVOCatchVariable -> "catch variable" - | TVOLocalFunction -> "function" - in - check_identifier_name ctx name (s_var_origin origin) p - let add_local_with_origin ctx origin n t p = - check_local_variable_name ctx n origin p; + Naming.check_local_variable_name ctx.com n origin p; add_local ctx (VUser origin) n t p let gen_local_prefix = "`" @@ -521,50 +466,50 @@ let is_gen_local v = match v.v_kind with | _ -> false -let delay ctx p f = +let delay g p f = let p = Obj.magic p in - let tasks = ctx.g.delayed.(p) in + let tasks = g.delayed.(p) in tasks.tasks <- f :: tasks.tasks; - if p < ctx.g.delayed_min_index then - ctx.g.delayed_min_index <- p + if p < g.delayed_min_index then + g.delayed_min_index <- p -let delay_late ctx p f = +let delay_late g p f = let p = Obj.magic p in - let tasks = ctx.g.delayed.(p) in + let tasks = g.delayed.(p) in tasks.tasks <- tasks.tasks @ [f]; - if p < ctx.g.delayed_min_index then - ctx.g.delayed_min_index <- p + if p < g.delayed_min_index then + g.delayed_min_index <- p -let delay_if_mono ctx p t f = match follow t with +let delay_if_mono g p t f = match follow t with | TMono _ -> - delay ctx p f + delay g p f | _ -> f() -let rec flush_pass ctx p where = +let rec flush_pass g p where = let rec loop i = if i > (Obj.magic p) then () else begin - let tasks = ctx.g.delayed.(i) in + let tasks = g.delayed.(i) in match tasks.tasks with | f :: l -> tasks.tasks <- l; f(); - flush_pass ctx p where + flush_pass g 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; + g.delayed_min_index <- i; loop i end in - loop ctx.g.delayed_min_index + loop g.delayed_min_index let make_pass ctx f = f -let enter_field_typing_pass ctx info = - flush_pass ctx PConnectField info +let enter_field_typing_pass g info = + flush_pass g PConnectField info let make_lazy ?(force=true) ctx t_proc f where = let r = ref (lazy_available t_dynamic) in @@ -581,24 +526,6 @@ let make_lazy ?(force=true) ctx t_proc f where = if force then delay ctx PForce (fun () -> ignore(lazy_type r)); r -let fake_modules = Hashtbl.create 0 -let create_fake_module ctx file = - let key = ctx.com.file_keys#get file in - let file = Path.get_full_path file in - let mdep = (try Hashtbl.find fake_modules key with Not_found -> - let mdep = { - m_id = alloc_mid(); - m_path = (["$DEP"],file); - m_types = []; - m_statics = None; - m_extra = module_extra file (Define.get_signature ctx.com.defines) (file_time file) MFake ctx.com.compilation_step []; - } in - Hashtbl.add fake_modules key mdep; - mdep - ) in - ctx.com.module_lut#add mdep.m_path mdep; - mdep - let is_removable_field com f = not (has_class_field_flag f CfOverride) && ( has_class_field_flag f CfExtern || has_class_field_flag f CfGeneric @@ -618,16 +545,6 @@ 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 @@ -763,40 +680,6 @@ let merge_core_doc ctx mt = end | _ -> ()) -let field_to_type_path com e = - let rec loop e pack name = match e with - | EField(e,f,_),p when Char.lowercase_ascii (String.get f 0) <> String.get f 0 -> (match name with - | [] | _ :: [] -> - loop e pack (f :: name) - | _ -> (* too many name paths *) - display_error com ("Unexpected " ^ f) p; - raise Exit) - | EField(e,f,_),_ -> - loop e (f :: pack) name - | EConst(Ident f),_ -> - let pack, name, sub = match name with - | [] -> - let fchar = String.get f 0 in - if Char.uppercase_ascii fchar = fchar then - pack, f, None - else begin - display_error com "A class name must start with an uppercase letter" (snd e); - raise Exit - end - | [name] -> - f :: pack, name, None - | [name; sub] -> - f :: pack, name, Some sub - | _ -> - die "" __LOC__ - in - { tpackage=pack; tname=name; tparams=[]; tsub=sub } - | _,pos -> - display_error com "Unexpected expression when building strict meta" pos; - raise Exit - in - loop e [] [] - let safe_mono_close ctx m p = try Monomorph.close m diff --git a/src/core/naming.ml b/src/core/naming.ml index 2a3b3641768..844a4a4fa8a 100644 --- a/src/core/naming.ml +++ b/src/core/naming.ml @@ -1,6 +1,8 @@ open Globals open Ast open Type +open Common +open Error (** retrieve string from @:native metadata or raise Not_found *) let get_native_name meta = @@ -84,3 +86,54 @@ let apply_native_paths t = ()) with Not_found -> () + + +let display_identifier_error com ?prepend_msg msg p = + let prepend = match prepend_msg with Some s -> s ^ " " | _ -> "" in + Common.display_error com (prepend ^ msg) p + +let check_identifier_name ?prepend_msg com name kind p = + if starts_with name '$' then + display_identifier_error com ?prepend_msg ((StringHelper.capitalize kind) ^ " names starting with a dollar are not allowed: \"" ^ name ^ "\"") p + else if not (Lexer.is_valid_identifier name) then + display_identifier_error com ?prepend_msg ("\"" ^ (StringHelper.s_escape name) ^ "\" is not a valid " ^ kind ^ " name.") p + +let check_field_name com name p = + match name with + | "new" -> () (* the only keyword allowed in field names *) + | _ -> check_identifier_name com name "field" p + +let check_uppercase_identifier_name ?prepend_msg com name kind p = + if String.length name = 0 then + display_identifier_error ?prepend_msg com ((StringHelper.capitalize kind) ^ " name must not be empty.") p + else if Ast.is_lower_ident name then + display_identifier_error ?prepend_msg com ((StringHelper.capitalize kind) ^ " name should start with an uppercase letter: \"" ^ name ^ "\"") p + else + check_identifier_name ?prepend_msg com name kind p + +let check_module_path com (pack,name) p = + let full_path = StringHelper.s_escape (if pack = [] then name else (String.concat "." pack) ^ "." ^ name) in + check_uppercase_identifier_name ~prepend_msg:("Module \"" ^ full_path ^ "\" does not have a valid name.") com name "module" p; + try + List.iter (fun part -> Path.check_package_name part) pack; + with Failure msg -> + display_error_ext com (make_error + ~sub:[make_error (Custom msg) p] + (Custom ("\"" ^ (StringHelper.s_escape (String.concat "." pack)) ^ "\" is not a valid package name:")) + p + ) + +let check_local_variable_name com name origin p = + match name with + | "this" -> () (* TODO: vars named `this` should technically be VGenerated, not VUser *) + | _ -> + let s_var_origin origin = + match origin with + | TVOLocalVariable -> "variable" + | TVOArgument -> "function argument" + | TVOForVariable -> "for variable" + | TVOPatternVariable -> "pattern variable" + | TVOCatchVariable -> "catch variable" + | TVOLocalFunction -> "function" + in + check_identifier_name com name (s_var_origin origin) p \ No newline at end of file diff --git a/src/typing/finalization.ml b/src/typing/finalization.ml index 61953a43f75..67189a59a15 100644 --- a/src/typing/finalization.ml +++ b/src/typing/finalization.ml @@ -79,7 +79,7 @@ let get_main ctx types = Some main let finalize ctx = - flush_pass ctx PFinal ("final",[]); + flush_pass ctx.g PFinal ("final",[]); match ctx.com.callbacks#get_after_typing with | [] -> () @@ -91,7 +91,7 @@ let finalize ctx = () | new_types -> List.iter (fun f -> f new_types) fl; - flush_pass ctx PFinal ("final",[]); + flush_pass ctx.g PFinal ("final",[]); loop all_types in loop [] diff --git a/src/typing/functionArguments.ml b/src/typing/functionArguments.ml index f7251a69ca3..0c478ae48c6 100644 --- a/src/typing/functionArguments.ml +++ b/src/typing/functionArguments.ml @@ -99,8 +99,8 @@ object(self) v.v_meta <- (Meta.This,[],null_pos) :: v.v_meta; loop ((v,None) :: acc) false syntax typed | ((_,pn),opt,m,_,_) :: syntax,(name,eo,t) :: typed -> - delay ctx PTypeField (fun() -> self#check_rest (typed = []) eo opt t pn); - if not is_extern then check_local_variable_name ctx name TVOArgument pn; + delay ctx.g PTypeField (fun() -> self#check_rest (typed = []) eo opt t pn); + if not is_extern then Naming.check_local_variable_name ctx.com name TVOArgument pn; let eo = type_function_arg_value ctx t eo do_display in let v = make_local name (VUser TVOArgument) t m pn in if do_display && DisplayPosition.display_position#enclosed_in pn then @@ -121,7 +121,7 @@ object(self) | syntax,(name,_,t) :: typed when is_abstract_this -> loop false syntax typed | ((_,pn),opt,m,_,_) :: syntax,(name,eo,t) :: typed -> - delay ctx PTypeField (fun() -> self#check_rest (typed = []) eo opt t pn); + delay ctx.g PTypeField (fun() -> self#check_rest (typed = []) eo opt t pn); ignore(type_function_arg_value ctx t eo do_display); loop false syntax typed | [],[] -> diff --git a/src/typing/generic.ml b/src/typing/generic.ml index 30e59364c07..a0eebd9e8c3 100644 --- a/src/typing/generic.ml +++ b/src/typing/generic.ml @@ -26,7 +26,8 @@ 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 f = {ctx.f with locals = PMap.empty}} e WithType.value in + let ctx = TyperManager.clone_for_type_parameter_expression ctx in + let e = type_expr ctx 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 +232,16 @@ let build_instances ctx t p = in loop t +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 + 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; @@ -288,8 +299,10 @@ let build_generic_class ctx c p tl = m_statics = None; m_extra = module_extra (s_type_path (pack,name)) m.m_extra.m_sign 0. MFake gctx.ctx.com.compilation_step m.m_extra.m_check_policy; } in + let ctx = TyperManager.clone_for_module ctx.g.root_typer (TypeloadModule.make_curmod ctx.com ctx.g mg) in gctx.mg <- Some mg; let cg = mk_class mg (pack,name) c.cl_pos c.cl_name_pos in + let ctx = TyperManager.clone_for_class ctx c in cg.cl_meta <- List.filter (fun (m,_,_) -> match m with | Meta.Access | Allow | Final @@ -337,7 +350,7 @@ let build_generic_class ctx c p tl = | None -> (* There can be cases like #11152 where cf_expr isn't ready yet. It should be safe to delay this to the end of the PTypeField pass. *) - delay_late ctx PTypeField (fun () -> match cf_old.cf_expr with + delay_late ctx.g PTypeField (fun () -> match cf_old.cf_expr with | Some e -> update_expr e | None -> @@ -355,7 +368,7 @@ let build_generic_class ctx c p tl = t in let t = spawn_monomorph ctx.e p in - let r = make_lazy ctx t (fun r -> + let r = make_lazy ctx.g t (fun r -> let t0 = f() in unify_raise t0 t p; link_dynamic t0 t; diff --git a/src/typing/instanceBuilder.ml b/src/typing/instanceBuilder.ml index 5d86ee883b9..8d0eeee7d3f 100644 --- a/src/typing/instanceBuilder.ml +++ b/src/typing/instanceBuilder.ml @@ -74,7 +74,7 @@ let get_build_info ctx mtype p = if ctx.pass > PBuildClass then ignore(c.cl_build()); let build f s tl = let t = spawn_monomorph ctx.e p in - let r = make_lazy ctx t (fun r -> + let r = make_lazy ctx.g t (fun r -> let tf = f tl in unify_raise tf t p; link_dynamic t tf; diff --git a/src/typing/macroContext.ml b/src/typing/macroContext.ml index 225c211339d..65b831ad254 100644 --- a/src/typing/macroContext.ml +++ b/src/typing/macroContext.ml @@ -57,24 +57,21 @@ let macro_timer com l = let typing_timer ctx need_type f = let t = Timer.timer ["typing"] in - let old = ctx.com.error_ext and oldlocals = ctx.f.locals in + let old = ctx.com.error_ext 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) - *) - (* if ctx.com.display.dms_kind = DMNone then ctx.com.error <- (fun e -> raise_error e); *) (* TODO: review this... *) + let restore_field_state = TypeloadFunction.save_field_state ctx in ctx.com.error_ext <- (fun err -> raise_error { err with err_from_macro = true }); let ctx = if need_type && ctx.pass < PTypeField then begin - enter_field_typing_pass ctx ("typing_timer",[] (* TODO: ? *)); - TyperManager.clone_for_expr ctx + enter_field_typing_pass ctx.g ("typing_timer",[]); + TyperManager.clone_for_expr ctx ctx.e.curfun false end else ctx in let exit() = t(); ctx.com.error_ext <- old; - ctx.f.locals <- oldlocals; + restore_field_state (); restore_report_mode (); in try @@ -465,7 +462,7 @@ let make_macro_api ctx mctx p = in let add is_macro ctx = let mdep = Option.map_default (fun s -> TypeloadModule.load_module ctx (parse_path s) pos) ctx.m.curmod mdep in - let mnew = TypeloadModule.type_module ctx ~dont_check_path:(has_native_meta) m (Path.UniqueKey.lazy_path mdep.m_extra.m_file) [tdef,pos] pos in + let mnew = TypeloadModule.type_module ctx.com ctx.g ~dont_check_path:(has_native_meta) m (Path.UniqueKey.lazy_path mdep.m_extra.m_file) [tdef,pos] pos in mnew.m_extra.m_kind <- if is_macro then MMacro else MFake; add_dependency mnew mdep; ctx.com.module_nonexistent_lut#clear; @@ -495,7 +492,7 @@ let make_macro_api ctx mctx p = let m = ctx.com.module_lut#find mpath in 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 + let mnew = TypeloadModule.type_module ctx.com ctx.g mpath (Path.UniqueKey.lazy_path ctx.m.curmod.m_extra.m_file) types pos in mnew.m_extra.m_kind <- MFake; add_dependency mnew ctx.m.curmod; ctx.com.module_nonexistent_lut#clear; @@ -508,7 +505,7 @@ let make_macro_api ctx mctx p = ctx.m.curmod.m_extra.m_deps <- old_deps; m ) in - add_dependency m (create_fake_module ctx file); + add_dependency m (TypeloadCacheHook.create_fake_module ctx.com file); ); MacroApi.current_module = (fun() -> ctx.m.curmod @@ -554,7 +551,7 @@ let make_macro_api ctx mctx p = List.iter (fun path -> ImportHandling.init_using ctx path null_pos ) usings; - flush_pass ctx PConnectField ("with_imports",[] (* TODO: ? *)); + flush_pass ctx.g PConnectField ("with_imports",[] (* TODO: ? *)); f() in let restore () = diff --git a/src/typing/strictMeta.ml b/src/typing/strictMeta.ml index 4acc0cf44f3..7ed54be3742 100644 --- a/src/typing/strictMeta.ml +++ b/src/typing/strictMeta.ml @@ -124,6 +124,40 @@ let make_meta ctx texpr extra = | _ -> display_error ctx.com "Unexpected expression" texpr.epos; die "" __LOC__ +let field_to_type_path com e = + let rec loop e pack name = match e with + | EField(e,f,_),p when Char.lowercase_ascii (String.get f 0) <> String.get f 0 -> (match name with + | [] | _ :: [] -> + loop e pack (f :: name) + | _ -> (* too many name paths *) + display_error com ("Unexpected " ^ f) p; + raise Exit) + | EField(e,f,_),_ -> + loop e (f :: pack) name + | EConst(Ident f),_ -> + let pack, name, sub = match name with + | [] -> + let fchar = String.get f 0 in + if Char.uppercase_ascii fchar = fchar then + pack, f, None + else begin + display_error com "A class name must start with an uppercase letter" (snd e); + raise Exit + end + | [name] -> + f :: pack, name, None + | [name; sub] -> + f :: pack, name, Some sub + | _ -> + die "" __LOC__ + in + { tpackage=pack; tname=name; tparams=[]; tsub=sub } + | _,pos -> + display_error com "Unexpected expression when building strict meta" pos; + raise Exit + in + loop e [] [] + let get_strict_meta ctx meta params pos = let pf = ctx.com.platform in let changed_expr, fields_to_check, ctype = match params with @@ -172,7 +206,7 @@ let get_strict_meta ctx meta params pos = raise Exit in let t = Typeload.load_complex_type ctx false (ctype,pos) in - flush_pass ctx PBuildClass "get_strict_meta"; + flush_pass ctx.g PBuildClass "get_strict_meta"; let texpr = type_expr ctx changed_expr NoValue in let with_type_expr = (ECheckType( (EConst (Ident "null"), pos), (ctype,null_pos) ), pos) in let extra = handle_fields ctx fields_to_check with_type_expr in diff --git a/src/typing/typeload.ml b/src/typing/typeload.ml index bfba81c88ac..5a2c33f0a52 100644 --- a/src/typing/typeload.ml +++ b/src/typing/typeload.ml @@ -279,7 +279,8 @@ let check_param_constraints ctx t map ttp p = in match follow t with | TInst({cl_kind = KExpr e},_) -> - let e = type_expr {ctx with f = {ctx.f with locals = PMap.empty}} e (WithType.with_type ti) in + let ctx = TyperManager.clone_for_type_parameter_expression ctx in + let e = type_expr ctx e (WithType.with_type ti) in begin try unify_raise e.etype ti p with Error { err_message = Unify _ } -> fail() end | _ -> @@ -390,7 +391,7 @@ let rec load_params ctx info params p = let t = apply_params info.build_params params t in maybe_build_instance ctx t ParamNormal p; in - delay ctx PCheckConstraint (fun () -> + delay ctx.g PCheckConstraint (fun () -> DynArray.iter (fun (t,c,p) -> check_param_constraints ctx t map c p ) checks @@ -471,7 +472,7 @@ and load_complex_type' ctx allow_display (t,p) = ) tl in let tr = Monomorph.create() in let t = TMono tr in - let r = make_lazy ctx t (fun r -> + let r = make_lazy ctx.g t (fun r -> let ta = make_extension_type ctx tl in Monomorph.bind tr ta; ta @@ -512,7 +513,7 @@ and load_complex_type' ctx allow_display (t,p) = ) tl in let tr = Monomorph.create() in let t = TMono tr in - let r = make_lazy ctx t (fun r -> + let r = make_lazy ctx.g t (fun r -> Monomorph.bind tr (match il with | [i] -> mk_extension i @@ -616,7 +617,7 @@ and load_complex_type' ctx allow_display (t,p) = | None -> () | Some cf -> - delay ctx PBuildClass (fun () -> DisplayEmitter.display_field ctx (AnonymousStructure a) CFSMember cf cf.cf_name_pos); + delay ctx.g PBuildClass (fun () -> DisplayEmitter.display_field ctx (AnonymousStructure a) CFSMember cf cf.cf_name_pos); end; TAnon a | CTFunction (args,r) -> @@ -635,7 +636,7 @@ and load_complex_type ctx allow_display (t,pn) = load_complex_type' ctx allow_display (t,pn) with Error ({ err_message = Module_not_found(([],name)) } as err) -> if Diagnostics.error_in_diagnostics_run ctx.com err.err_pos then begin - delay ctx PForce (fun () -> DisplayToplevel.handle_unresolved_identifier ctx name err.err_pos true); + delay ctx.g PForce (fun () -> DisplayToplevel.handle_unresolved_identifier ctx name err.err_pos true); t_dynamic end else if ignore_error ctx.com && not (DisplayPosition.display_position#enclosed_in pn) then t_dynamic @@ -739,13 +740,13 @@ and type_type_params ctx host path p tpl = 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 + let ctx = TyperManager.clone_for_type_params ctx (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 r = make_lazy ctx.g ttp.ttp_type (fun r -> let t = load_complex_type ctx true ct in begin match host with | TPHType -> @@ -785,7 +786,7 @@ and type_type_params ctx host path p tpl = List.iter loop constr; constr ) in - delay ctx PConnectField (fun () -> ignore (Lazy.force constraints)); + delay ctx.g PConnectField (fun () -> ignore (Lazy.force constraints)); ttp.ttp_constraints <- Some constraints; ) param_pairs; params @@ -819,7 +820,7 @@ let load_core_class ctx c = | _ -> c.cl_path in let t = load_type_def' ctx2 (fst c.cl_module.m_path) (snd c.cl_module.m_path) (snd tpath) null_pos in - flush_pass ctx2 PFinal ("core_final",(fst c.cl_path @ [snd c.cl_path])); + flush_pass ctx2.g PFinal ("core_final",(fst c.cl_path @ [snd c.cl_path])); match t with | TClassDecl ccore | TAbstractDecl {a_impl = Some ccore} -> ccore diff --git a/src/typing/typeloadCacheHook.ml b/src/typing/typeloadCacheHook.ml new file mode 100644 index 00000000000..b9be6a15346 --- /dev/null +++ b/src/typing/typeloadCacheHook.ml @@ -0,0 +1,31 @@ +open Globals +open TType +open Common +open TFunctions + +type find_module_result = + | GoodModule of module_def + | BadModule of module_skip_reason + | BinaryModule of HxbData.module_cache + | NoModule + +let type_module_hook : (Common.context -> path -> pos -> find_module_result) ref = ref (fun _ _ _ -> NoModule) + +let fake_modules = Hashtbl.create 0 + +let create_fake_module com file = + let key = com.file_keys#get file in + let file = Path.get_full_path file in + let mdep = (try Hashtbl.find fake_modules key with Not_found -> + let mdep = { + m_id = alloc_mid(); + m_path = (["$DEP"],file); + m_types = []; + m_statics = None; + m_extra = module_extra file (Define.get_signature com.defines) (file_time file) MFake com.compilation_step []; + } in + Hashtbl.add fake_modules key mdep; + mdep + ) in + com.module_lut#add mdep.m_path mdep; + mdep \ No newline at end of file diff --git a/src/typing/typeloadCheck.ml b/src/typing/typeloadCheck.ml index 6532c9e99f3..5369903fb96 100644 --- a/src/typing/typeloadCheck.ml +++ b/src/typing/typeloadCheck.ml @@ -47,7 +47,7 @@ let is_generic_parameter ctx c = with Not_found -> false -let valid_redefinition ctx map1 map2 f1 t1 f2 t2 = (* child, parent *) +let valid_redefinition map1 map2 f1 t1 f2 t2 = (* child, parent *) let valid t1 t2 = Type.unify t1 t2; if is_null t1 <> is_null t2 || ((follow t1) == t_dynamic && (follow t2) != t_dynamic) then raise (Unify_error [Cannot_unify (t1,t2)]); @@ -186,7 +186,7 @@ let check_override_field ctx p rctx = display_error ctx.com ("Field " ^ i ^ " has different property access than in superclass") p); if (has_class_field_flag rctx.cf_old CfFinal) then display_error ctx.com ("Cannot override final method " ^ i) p; try - valid_redefinition ctx rctx.map rctx.map rctx.cf_new rctx.cf_new.cf_type rctx.cf_old rctx.t_old; + valid_redefinition rctx.map rctx.map rctx.cf_new rctx.cf_new.cf_type rctx.cf_old rctx.t_old; with Unify_error l -> (* TODO construct error with sub *) @@ -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.m.is_display_file then delay ctx PCheckConstraint (fun () -> DisplayEmitter.check_display_metadata ctx meta) + if ctx.m.is_display_file then delay ctx.g PCheckConstraint (fun () -> DisplayEmitter.check_display_metadata ctx meta) module Inheritance = struct let is_basic_class_path path = match path with @@ -351,9 +351,9 @@ module Inheritance = struct end | t -> raise_typing_error (Printf.sprintf "Should extend by using a class, found %s" (s_type_kind t)) p - let rec check_interface ctx missing c intf params = + let rec check_interface com g missing c intf params = List.iter (fun (i2,p2) -> - check_interface ctx missing c i2 (List.map (apply_params intf.cl_params params) p2) + check_interface com g missing c i2 (List.map (apply_params intf.cl_params params) p2) ) intf.cl_implements; let p = c.cl_name_pos in let check_field f = @@ -363,7 +363,7 @@ module Inheritance = struct let cf = {f with cf_overloads = []; cf_type = apply_params intf.cl_params params f.cf_type} in begin try let cf' = PMap.find cf.cf_name c.cl_fields in - ctx.com.overload_cache#remove (c.cl_path,f.cf_name); + com.overload_cache#remove (c.cl_path,f.cf_name); cf'.cf_overloads <- cf :: cf'.cf_overloads with Not_found -> TClass.add_field c cf @@ -378,13 +378,13 @@ module Inheritance = struct let map2, t2, f2 = class_field_no_interf c f.cf_name in let t2, f2 = if f2.cf_overloads <> [] || has_class_field_flag f2 CfOverload then - let overloads = get_overloads ctx.com c f.cf_name in + let overloads = get_overloads com c f.cf_name in is_overload := true; List.find (fun (t1,f1) -> Overloads.same_overload_args t t1 f f1) overloads else t2, f2 in - delay ctx PForce (fun () -> + delay g PForce (fun () -> ignore(follow f2.cf_type); (* force evaluation *) let p = f2.cf_name_pos in let mkind = function @@ -393,19 +393,19 @@ module Inheritance = struct | MethMacro -> 2 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 + display_error com ("Field " ^ f.cf_name ^ " should be public as requested by " ^ s_type_path intf.cl_path) p 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 + display_error 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 - valid_redefinition ctx map1 map2 f2 t2 f (apply_params intf.cl_params params f.cf_type) + valid_redefinition map1 map2 f2 t2 f (apply_params intf.cl_params params f.cf_type) with Unify_error l -> if not (Meta.has Meta.CsNative c.cl_meta && (has_class_flag c CExtern)) then begin (* TODO construct error with sub *) - display_error ctx.com ("Field " ^ f.cf_name ^ " has different type than in " ^ s_type_path intf.cl_path) p; - display_error ~depth:1 ctx.com (compl_msg "Interface field is defined here") f.cf_pos; - display_error ~depth:1 ctx.com (compl_msg (error_msg (Unify l))) p; + display_error com ("Field " ^ f.cf_name ^ " has different type than in " ^ s_type_path intf.cl_path) p; + display_error ~depth:1 com (compl_msg "Interface field is defined here") f.cf_pos; + display_error ~depth:1 com (compl_msg (error_msg (Unify l))) p; end ) with Not_found -> @@ -418,7 +418,7 @@ module Inheritance = struct add_class_field_flag cf CfExtern; add_class_field_flag cf CfOverride; end else if not (has_class_flag c CInterface) then begin - if Diagnostics.error_in_diagnostics_run ctx.com c.cl_pos then + if Diagnostics.error_in_diagnostics_run com c.cl_pos then DynArray.add missing (f,t) else begin let msg = if !is_overload then @@ -428,7 +428,7 @@ module Inheritance = struct else ("Field " ^ f.cf_name ^ " needed by " ^ s_type_path intf.cl_path ^ " is missing") in - display_error ctx.com msg p + display_error com msg p end end in @@ -445,7 +445,7 @@ module Inheritance = struct | _ -> List.iter (fun (intf,params) -> let missing = DynArray.create () in - check_interface ctx missing c intf params; + check_interface ctx.com ctx.g missing c intf params; if DynArray.length missing > 0 then begin let l = DynArray.to_list missing in let diag = { @@ -544,7 +544,7 @@ module Inheritance = struct we do want to check them at SOME point. So we use this pending list which was maybe designed for this purpose. However, we STILL have to delay the check because at the time pending is handled, the class is not built yet. See issue #10847. *) - pending := (fun () -> delay ctx PConnectField check_interfaces_or_delay) :: !pending + pending := (fun () -> delay ctx.g PConnectField check_interfaces_or_delay) :: !pending | _ when ctx.com.display.dms_full_typing -> check_interfaces ctx c | _ -> @@ -557,7 +557,7 @@ module Inheritance = struct if not (has_class_flag csup CInterface) then raise_typing_error (Printf.sprintf "Cannot extend by using a class (%s extends %s)" (s_type_path c.cl_path) (s_type_path csup.cl_path)) p; c.cl_implements <- (csup,params) :: c.cl_implements; if not !has_interf then begin - if not is_lib then delay ctx PConnectField check_interfaces_or_delay; + if not is_lib then delay ctx.g PConnectField check_interfaces_or_delay; has_interf := true; end end else begin @@ -579,7 +579,7 @@ module Inheritance = struct if not (has_class_flag intf CInterface) then raise_typing_error "You can only implement an interface" p; c.cl_implements <- (intf, params) :: c.cl_implements; if not !has_interf && not is_lib && not (Meta.has (Meta.Custom "$do_not_check_interf") c.cl_meta) then begin - delay ctx PConnectField check_interfaces_or_delay; + delay ctx.g PConnectField check_interfaces_or_delay; has_interf := true; end; (fun () -> diff --git a/src/typing/typeloadFields.ml b/src/typing/typeloadFields.ml index 200470095e2..0a2465b99e2 100644 --- a/src/typing/typeloadFields.ml +++ b/src/typing/typeloadFields.ml @@ -240,7 +240,7 @@ let ensure_struct_init_constructor ctx c ast_fields p = cf.cf_meta <- [Meta.CompilerGenerated,[],null_pos; Meta.InheritDoc,[],null_pos]; cf.cf_kind <- Method MethNormal; c.cl_constructor <- Some cf; - delay ctx PTypeField (fun() -> InheritDoc.build_class_field_doc ctx (Some c) cf) + delay ctx.g PTypeField (fun() -> InheritDoc.build_class_field_doc ctx (Some c) cf) let transform_abstract_field com this_t a_t a f = let stat = List.mem_assoc AStatic f.cff_access in @@ -416,7 +416,7 @@ let build_module_def ctx mt meta fvars fbuild = | _ -> t_infos mt in (* Delay for #10107, but use delay_late to make sure base classes run before their children do. *) - delay_late ctx PConnectField (fun () -> + delay_late ctx.g PConnectField (fun () -> ti.mt_using <- (filter_classes types) @ ti.mt_using ) with Exit -> @@ -440,7 +440,7 @@ let build_module_def ctx mt meta fvars fbuild = let inherit_using (c,_) = ti.mt_using <- ti.mt_using @ (t_infos (TClassDecl c)).mt_using in - delay_late ctx PConnectField (fun () -> + delay_late ctx.g PConnectField (fun () -> Option.may inherit_using csup; List.iter inherit_using interfaces; ); @@ -607,7 +607,6 @@ 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.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 @@ -674,7 +673,7 @@ module TypeBinding = struct in let force_macro display = (* force macro system loading of this class in order to get completion *) - delay ctx PTypeField (fun() -> + delay ctx.g PTypeField (fun() -> try ignore(ctx.g.do_macro ctx MDisplay c.cl_path cf.cf_name [] p) with @@ -744,7 +743,7 @@ module TypeBinding = struct let c = cctx.tclass in let t = cf.cf_type in let p = cf.cf_pos in - let ctx = TyperManager.clone_for_expr ctx_f in + let ctx = TyperManager.clone_for_expr ctx_f (if fctx.is_static then FunStatic else FunMember) false in if (has_class_flag c CInterface) then unexpected_expression ctx.com fctx "Initialization on field of interface" (pos e); cf.cf_meta <- ((Meta.Value,[e],null_pos) :: cf.cf_meta); let check_cast e = @@ -759,10 +758,10 @@ module TypeBinding = struct mk_cast e cf.cf_type e.epos end in - let r = make_lazy ~force:false ctx t (fun r -> + let r = make_lazy ~force:false ctx.g t (fun r -> (* type constant init fields (issue #1956) *) 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]); + enter_field_typing_pass ctx.g ("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 @@ -835,18 +834,12 @@ module TypeBinding = struct | Some e -> bind_var_expression ctx cctx fctx cf e - let bind_method ctx_f cctx fctx cf t args ret e p = + let bind_method ctx_f cctx fctx fmode cf t args ret e p = let c = cctx.tclass in - let ctx = TyperManager.clone_for_expr ctx_f in + let ctx = TyperManager.clone_for_expr ctx_f fmode true in let bind r = incr stats.s_methods_typed; if (Meta.has (Meta.Custom ":debug.typing") (c.cl_meta @ cf.cf_meta)) then ctx.com.print (Printf.sprintf "Typing method %s.%s\n" (s_type_path c.cl_path) cf.cf_name); - let fmode = (match cctx.abstract with - | Some _ -> - if fctx.is_abstract_member then FunMemberAbstract else FunStatic - | None -> - 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 -> if e <> None then @@ -870,7 +863,7 @@ module TypeBinding = struct | _ -> (fun () -> ()) in - let e = TypeloadFunction.type_function ctx args ret fmode e fctx.is_display_field p in + let e = TypeloadFunction.type_function ctx args ret e fctx.is_display_field p in f_check(); (* Disabled for now, see https://github.com/HaxeFoundation/haxe/issues/3033 *) (* List.iter (fun (v,_) -> @@ -894,7 +887,7 @@ module TypeBinding = struct 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 + let r = make_lazy ~force:false ctx.g t maybe_bind "type_fun" in bind_type ctx cctx fctx cf r p end @@ -958,7 +951,7 @@ let check_abstract (ctx,cctx,fctx) a c cf fd t ret p = fctx.expr_presence_matters <- true; end in let handle_from () = - let r = make_lazy ctx t (fun r -> + let r = make_lazy ctx.g t (fun r -> (* the return type of a from-function must be the abstract, not the underlying type *) if not fctx.is_macro then (try type_eq EqStrict ret ta with Unify_error l -> raise_typing_error_ext (make_error (Unify l) p)); match t with @@ -998,7 +991,7 @@ let check_abstract (ctx,cctx,fctx) a c cf fd t ret p = let is_multitype_cast = Meta.has Meta.MultiType a.a_meta && not fctx.is_abstract_member in if is_multitype_cast && not (Meta.has Meta.MultiType cf.cf_meta) then cf.cf_meta <- (Meta.MultiType,[],null_pos) :: cf.cf_meta; - let r = make_lazy ctx t (fun r -> + let r = make_lazy ctx.g t (fun r -> let args = if is_multitype_cast then begin let ctor = try PMap.find "_new" c.cl_statics @@ -1334,27 +1327,28 @@ let create_method (ctx,cctx,fctx) c f fd p = () ) parent; generate_args_meta ctx.com (Some c) (fun meta -> cf.cf_meta <- meta :: cf.cf_meta) fd.f_args; - begin match cctx.abstract with - | Some a -> - check_abstract (ctx,cctx,fctx) a c cf fd t ret p; - | _ -> - () - end; + let fmode = match cctx.abstract with + | Some a -> + check_abstract (ctx,cctx,fctx) a c cf fd t ret p; + if fctx.is_abstract_member then FunMemberAbstract else FunStatic + | _ -> + if fctx.field_kind = CfrConstructor then FunConstructor else if fctx.is_static then FunStatic else FunMember + in init_meta_overloads ctx (Some c) 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) + TypeBinding.bind_method ctx cctx fctx fmode cf t args ret fd.f_expr (match fd.f_expr with Some e -> snd e | None -> f.cff_pos) else begin if fctx.is_display_field then begin - delay ctx PTypeField (fun () -> + delay ctx.g PTypeField (fun () -> (* We never enter type_function so we're missing out on the argument processing there. Let's do it here. *) - let ctx = TyperManager.clone_for_expr ctx in + let ctx = TyperManager.clone_for_expr ctx fmode true in ignore(args#for_expr ctx) ); check_field_display ctx fctx c cf; end else - delay ctx PTypeField (fun () -> - let ctx = TyperManager.clone_for_expr ctx in + delay ctx.g PTypeField (fun () -> + let ctx = TyperManager.clone_for_expr ctx fmode true in args#verify_extern ctx ); if fd.f_expr <> None then begin @@ -1413,7 +1407,7 @@ let create_property (ctx,cctx,fctx) c f (get,set,t,eo) p = (* Now that we know there is a field, we have to delay the actual unification even further. The reason is that unification could resolve TLazy, which would then cause field typing before we're done with our PConnectField pass. This could cause interface fields to not be generated in time. *) - delay ctx PForce (fun () -> + delay ctx.g PForce (fun () -> try (match f2.cf_kind with | Method MethMacro -> @@ -1465,7 +1459,7 @@ let create_property (ctx,cctx,fctx) c f (get,set,t,eo) p = with Not_found -> () in - let delay_check = delay ctx PConnectField in + let delay_check = delay ctx.g PConnectField in let get = (match get with | "null",_ -> AccNo | "dynamic",_ -> AccCall @@ -1473,7 +1467,7 @@ let create_property (ctx,cctx,fctx) c f (get,set,t,eo) p = | "default",_ -> AccNormal | "get",pget -> let get = "get_" ^ name in - if fctx.is_display_field && DisplayPosition.display_position#enclosed_in pget then delay ctx PConnectField (fun () -> display_accessor get pget); + if fctx.is_display_field && DisplayPosition.display_position#enclosed_in pget then delay ctx.g PConnectField (fun () -> display_accessor get pget); if not cctx.is_lib then delay_check (fun() -> check_method get t_get true); AccCall | _,pget -> @@ -1492,7 +1486,7 @@ let create_property (ctx,cctx,fctx) c f (get,set,t,eo) p = | "default",_ -> AccNormal | "set",pset -> let set = "set_" ^ name in - if fctx.is_display_field && DisplayPosition.display_position#enclosed_in pset then delay ctx PConnectField (fun () -> display_accessor set pset); + if fctx.is_display_field && DisplayPosition.display_position#enclosed_in pset then delay ctx.g PConnectField (fun () -> display_accessor set pset); if not cctx.is_lib then delay_check (fun() -> check_method set t_set false); AccCall | _,pset -> @@ -1527,7 +1521,7 @@ let init_field (ctx,cctx,fctx) f = let name = fst f.cff_name in TypeloadCheck.check_global_metadata ctx f.cff_meta (fun m -> f.cff_meta <- m :: f.cff_meta) c.cl_module.m_path c.cl_path (Some name); let p = f.cff_pos in - if not (has_class_flag c CExtern) && not (Meta.has Meta.Native f.cff_meta) then Typecore.check_field_name ctx name p; + if not (has_class_flag c CExtern) && not (Meta.has Meta.Native f.cff_meta) then Naming.check_field_name ctx.com name p; List.iter (fun acc -> match (fst acc, f.cff_kind) with | AFinal, FProp _ when not (has_class_flag c CExtern) && ctx.com.platform <> Java -> invalid_modifier_on_property ctx.com fctx (Ast.s_placed_access acc) (snd acc) @@ -1563,7 +1557,7 @@ let init_field (ctx,cctx,fctx) f = in (if (fctx.is_static || fctx.is_macro && ctx.com.is_macro_context) then add_class_field_flag cf CfStatic); if Meta.has Meta.InheritDoc cf.cf_meta then - delay ctx PTypeField (fun() -> InheritDoc.build_class_field_doc ctx (Some c) cf); + delay ctx.g PTypeField (fun() -> InheritDoc.build_class_field_doc ctx (Some c) cf); cf let check_overload ctx f fs is_extern_class = @@ -1616,7 +1610,7 @@ let finalize_class cctx = List.iter (fun (ctx,r) -> (match r with | None -> () - | Some r -> delay ctx PTypeField (fun() -> ignore(lazy_type r))) + | Some r -> delay ctx.g PTypeField (fun() -> ignore(lazy_type r))) ) cctx.delayed_expr let check_functional_interface ctx c = @@ -1647,13 +1641,13 @@ 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 = 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 cctx.is_core_api && com.display.dms_check_core_api then delay ctx_c.g PForce (fun() -> init_core_api ctx_c c); if not cctx.is_lib then begin - delay ctx_c PForce (fun() -> check_overloads ctx_c c); + delay ctx_c.g 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_c PForce (fun () -> TypeloadCheck.Inheritance.check_abstract_class ctx_c c csup tl); + delay ctx_c.g PForce (fun () -> TypeloadCheck.Inheritance.check_abstract_class ctx_c c csup tl); | None -> () end @@ -1768,7 +1762,7 @@ let init_class ctx_c cctx c p herits fields = 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 + delay ctx_c.g PConnectField (fun () -> match follow c.cl_type with | TAnon an -> an.a_fields <- c.cl_statics | _ -> diff --git a/src/typing/typeloadFunction.ml b/src/typing/typeloadFunction.ml index 9e8b073b3c6..536e14cf0af 100644 --- a/src/typing/typeloadFunction.ml +++ b/src/typing/typeloadFunction.ml @@ -36,13 +36,11 @@ let save_field_state ctx = let type_function_params ctx fd host fname p = 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.e.in_function <- true; - ctx.e.curfun <- fmode; +let type_function ctx (args : function_arguments) ret e do_display p = 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]); + enter_field_typing_pass ctx.g ("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 -> @@ -53,7 +51,7 @@ let type_function ctx (args : function_arguments) ret fmode e do_display p = *) EBlock [],p else - if fmode = FunMember && has_class_flag ctx.c.curclass CAbstract then + if ctx.e.curfun = 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 @@ -110,10 +108,10 @@ let type_function ctx (args : function_arguments) ret fmode e do_display p = with Not_found -> None in - let e = if fmode <> FunConstructor then + let e = if ctx.e.curfun <> FunConstructor then e else begin - delay ctx PForce (fun () -> TypeloadCheck.check_final_vars ctx e); + delay ctx.g PForce (fun () -> TypeloadCheck.check_final_vars ctx e); match has_super_constr() with | Some (was_forced,t_super) -> (try @@ -163,9 +161,9 @@ let type_function ctx (args : function_arguments) ret fmode e do_display p = if is_position_debug then print_endline ("typing:\n" ^ (Texpr.dump_with_pos "" e)); e -let type_function ctx args ret fmode e do_display p = +let type_function ctx args ret e do_display p = let save = save_field_state ctx in - Std.finally save (type_function ctx args ret fmode e do_display) p + Std.finally save (type_function ctx args ret e do_display) p let add_constructor ctx_c c force_constructor p = if c.cl_constructor <> None then () else @@ -177,7 +175,7 @@ let add_constructor ctx_c c force_constructor p = cf.cf_params <- cfsup.cf_params; cf.cf_meta <- List.filter (fun (m,_,_) -> m = Meta.CompilerGenerated) cfsup.cf_meta; let t = spawn_monomorph ctx_c.e p in - let r = make_lazy ctx_c t (fun r -> + let r = make_lazy ctx_c.g 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; diff --git a/src/typing/typeloadModule.ml b/src/typing/typeloadModule.ml index cc8a2c0d1a9..906492bcfa7 100644 --- a/src/typing/typeloadModule.ml +++ b/src/typing/typeloadModule.ml @@ -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_m type_name "type" p; + if type_name <> module_name && not (Meta.has Meta.Native meta) then Naming.check_uppercase_identifier_name ctx_m.com type_name "type" p; in let acc = (match fst decl with | EImport _ | EUsing _ -> @@ -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_m PBuildModule (fun () -> + delay ctx_m.g PBuildModule (fun () -> match t.t_type with | TMono r -> (match r.tm_type with None -> Monomorph.bind r com.basic.tvoid | _ -> ()) | _ -> () @@ -405,7 +405,7 @@ module TypeLevel = struct with TypeloadCheck.Build_canceled state -> c.cl_build <- make_pass ctx_c build; let rebuild() = - delay_late ctx_c PBuildClass (fun() -> ignore(c.cl_build())); + delay_late ctx_c.g PBuildClass (fun() -> ignore(c.cl_build())); in (match state with | Built -> die "" __LOC__ @@ -424,11 +424,11 @@ module TypeLevel = struct build() in c.cl_build <- make_pass ctx_m build; - delay ctx_m PBuildClass (fun() -> ignore(c.cl_build())); + delay ctx_m.g PBuildClass (fun() -> ignore(c.cl_build())); if Meta.has Meta.InheritDoc c.cl_meta then - delay ctx_m PConnectField (fun() -> InheritDoc.build_class_doc ctx_m c); + delay ctx_m.g 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 () -> + delay ctx_m.g 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 = @@ -498,16 +498,16 @@ module TypeLevel = struct incr index; names := (fst c.ec_name) :: !names; if Meta.has Meta.InheritDoc f.ef_meta then - delay ctx_en PConnectField (fun() -> InheritDoc.build_enum_field_doc ctx_en f); + delay ctx_en.g 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_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_en PConnectField (fun() -> InheritDoc.build_enum_doc ctx_en e); + delay ctx_en.g 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 () -> + delay ctx_en.g 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 -> @@ -547,7 +547,7 @@ module TypeLevel = struct | _ -> () in - let r = make_lazy ctx_td tt (fun r -> + let r = make_lazy ctx_td.g tt (fun r -> check_rec tt; tt ) "typedef_rec_check" in @@ -562,7 +562,7 @@ module TypeLevel = struct | _ -> die "" __LOC__); 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 () -> + delay ctx_td.g PTypeField (fun () -> let metas = StrictMeta.check_strict_meta ctx_td t.t_meta in if metas <> [] then t.t_meta <- metas @ t.t_meta; ) @@ -586,7 +586,7 @@ module TypeLevel = struct 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_a t (fun r -> + let r = make_lazy ctx_a.g 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 @@ -607,7 +607,7 @@ module TypeLevel = struct 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_a true t in - delay ctx_a PForce (fun () -> + delay ctx_a.g PForce (fun () -> let rec loop stack t = match follow t with | TAbstract(a,_) when not (Meta.has Meta.CoreType a.a_meta) -> @@ -634,7 +634,7 @@ 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_a PConnectField (fun() -> InheritDoc.build_abstract_doc ctx_a a) + delay ctx_a.g 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 @@ -697,7 +697,7 @@ let make_curmod com g m = Creates a module context for [m] and types [tdecls] using it. *) 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 ctx_m = TyperManager.clone_for_module g.root_typer (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. @@ -715,48 +715,47 @@ let type_types_into_module com g m tdecls p = (* setup module types *) List.iter (TypeLevel.init_module_type ctx_m) tdecls; (* Make sure that we actually init the context at some point (issue #9012) *) - delay ctx_m PConnectField (fun () -> ctx_m.m.import_resolution#resolve_lazies); + delay ctx_m.g PConnectField (fun () -> ctx_m.m.import_resolution#resolve_lazies); ctx_m (* Creates a new module and types [tdecls] into it. *) -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; +let type_module com g mpath file ?(dont_check_path=false) ?(is_extern=false) tdecls p = + let m = ModuleLevel.make_module com g mpath file p in + com.module_lut#add m.m_path m; + let tdecls = ModuleLevel.handle_import_hx com g m tdecls p in + let ctx_m = type_types_into_module com g m tdecls p in + if is_extern then m.m_extra.m_kind <- MExtern else if not dont_check_path then Naming.check_module_path ctx_m.com 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 _ _ _ -> NoModule) - class hxb_reader_api_typeload - (ctx : typer) - (load_module : typer -> path -> pos -> module_def) + (com : context) + (g : typer_globals) + (load_module : context -> typer_globals -> 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 + let m = ModuleLevel.make_module com 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 + 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 + let m = load_module com g (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 + load_module com g path p method basic_types = - ctx.com.basic + com.basic method get_var_id (i : int) = (* The v_id in .hxb has no relation to this context, make a new one. *) @@ -765,22 +764,22 @@ class hxb_reader_api_typeload !uid method read_expression_eagerly (cf : tclass_field) = - ctx.com.is_macro_context || match cf.cf_kind with + com.is_macro_context || match cf.cf_kind with | Var _ -> true | Method _ -> - delay ctx PTypeField (fun () -> ignore(follow cf.cf_type)); + delay g PTypeField (fun () -> ignore(follow cf.cf_type)); false end -let rec load_hxb_module ctx path p = +let rec load_hxb_module com g 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 api = (new hxb_reader_api_typeload com g load_module' p :> HxbReaderApi.hxb_reader_api) in + let reader = new HxbReader.hxb_reader path com.hxb_reader_stats in let read = reader#read api bytes in let m = read EOT in - delay ctx PConnectField (fun () -> + delay g PConnectField (fun () -> ignore(read EOM); ); m @@ -790,7 +789,7 @@ let rec load_hxb_module ctx path p = Printf.eprintf " => %s\n%s\n" msg stack; raise e in - let target = Common.platform_name_macro ctx.com in + let target = Common.platform_name_macro com in let rec loop l = match l with | hxb_lib :: l -> begin match hxb_lib#get_bytes target path with @@ -802,35 +801,35 @@ let rec load_hxb_module ctx path p = | [] -> raise Not_found in - loop ctx.com.hxb_libs + loop com.hxb_libs -and load_module' ctx m p = +and load_module' com g m p = try (* Check current context *) - ctx.com.module_lut#find m + com.module_lut#find m with Not_found -> (* Check cache *) - match !type_module_hook ctx m p with + match !TypeloadCacheHook.type_module_hook com m p with | GoodModule m -> m | BinaryModule _ -> die "" __LOC__ (* The server builds those *) | NoModule | BadModule _ -> try - load_hxb_module ctx m p + load_hxb_module com g 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(); + if com.module_nonexistent_lut#mem m then raise_not_found(); + if g.load_only_cached_modules then raise_not_found(); let is_extern = ref false in let file, decls = try (* Try parsing *) - let rfile,decls = TypeloadParse.parse_module ctx m p in + let rfile,decls = TypeloadParse.parse_module com m p in rfile.file,decls with Not_found -> (* Nothing to parse, try loading extern type *) let rec loop = function | [] -> - ctx.com.module_nonexistent_lut#add m true; + com.module_nonexistent_lut#add m true; raise_not_found() | (file,load) :: l -> match load m p with @@ -838,15 +837,15 @@ and load_module' ctx m p = | Some (_,a) -> file, a in is_extern := true; - loop ctx.com.load_extern_type + loop com.load_extern_type in let is_extern = !is_extern in - type_module ctx m file ~is_extern decls p + type_module com g m file ~is_extern decls p let load_module ctx m p = - let m2 = load_module' ctx m p in + let m2 = load_module' ctx.com ctx.g 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]); + if ctx.pass = PTypeField then flush_pass ctx.g PConnectField ("load_module",fst m @ [snd m]); m2 (* let load_module ctx m p = diff --git a/src/typing/typeloadParse.ml b/src/typing/typeloadParse.ml index eef20a8e975..238ab8ade5b 100644 --- a/src/typing/typeloadParse.ml +++ b/src/typing/typeloadParse.ml @@ -296,14 +296,14 @@ let parse_module' com m p = let pack,decls = parse_module_file com rfile p in rfile,remap,pack,decls -let parse_module ctx m p = - let rfile,remap,pack,decls = parse_module' ctx.com m p in +let parse_module com m p = + let rfile,remap,pack,decls = parse_module' 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 + display_error 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 " ^ rfile.file ^ " should be " ^ spack (fst m)) {p with pmax = p.pmin} + display_error com (spack pack ^ " in " ^ rfile.file ^ " should be " ^ spack (fst m)) {p with pmax = p.pmin} end; rfile, if !remap <> fst m then (* build typedefs to redirect to real package *) diff --git a/src/typing/typer.ml b/src/typing/typer.ml index 25e48f28733..9f74c11e891 100644 --- a/src/typing/typer.ml +++ b/src/typing/typer.ml @@ -737,7 +737,7 @@ and type_vars ctx vl p = add_local ctx VGenerated n t_dynamic pv, None (* TODO: What to do with this... *) ) vl in List.iter (fun (v,_) -> - delay_if_mono ctx PTypeField v.v_type (fun() -> + delay_if_mono ctx.g PTypeField v.v_type (fun() -> if ExtType.is_void (follow v.v_type) then raise_typing_error "Variables of type Void are not allowed" v.v_pos ) @@ -1234,7 +1234,7 @@ and type_local_function ctx_from kind f with_type p = | FunMemberAbstractLocal -> FunMemberAbstractLocal | _ -> FunMemberClassLocal in - let ctx = TyperManager.clone_for_expr ctx_from in + let ctx = TyperManager.clone_for_expr ctx_from curfun true in let old_tp = ctx.type_params in ctx.type_params <- params @ ctx.type_params; if not inline then ctx.e.in_loop <- false; @@ -1338,7 +1338,7 @@ and type_local_function ctx_from kind f with_type p = if params <> [] then v.v_extra <- Some (var_extra params None); Some v ) in - let e = TypeloadFunction.type_function ctx args rt curfun f.f_expr ctx.f.in_display p in + let e = TypeloadFunction.type_function ctx args rt f.f_expr ctx.f.in_display p in ctx.type_params <- old_tp; let tf = { tf_args = args#for_expr ctx; diff --git a/src/typing/typerEntry.ml b/src/typing/typerEntry.ml index 72ae8d3bf57..f088234bd33 100644 --- a/src/typing/typerEntry.ml +++ b/src/typing/typerEntry.ml @@ -7,7 +7,7 @@ open Resolution open Error let create com macros = - let ctx = { + let rec ctx = { com = com; t = com.basic; g = { @@ -36,6 +36,7 @@ let create com macros = do_format_string = format_string; do_load_core_class = Typeload.load_core_class; delayed_display = None; + root_typer = ctx; }; m = { curmod = null_module; @@ -52,7 +53,7 @@ let create com macros = get_build_infos = (fun() -> None); }; f = TyperManager.create_ctx_f null_field; - e = TyperManager.create_ctx_e (); + e = TyperManager.create_ctx_e FunStatic false; pass = PBuildModule; allow_inline = true; allow_transform = true; From c880d1decd98ab5081ad3820cf7cbc0bb28024ab Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Mon, 5 Feb 2024 11:55:20 +0100 Subject: [PATCH 44/51] Add server/resetCache and use it in the server tests (#11482) * [server] add server/resetCache and use it in the server tests * found it * reset more (but it's still not enough) * dodge segfault case to see if there are further problems * [tests] setup: give GC some time to run when needed * relocate fake_modules to global typer * check if the full suite makes things worse still * are you the culprit? --------- Co-authored-by: Rudy Ges --- src/compiler/compilationCache.ml | 8 ++++++++ src/compiler/server.ml | 2 +- src/compiler/serverCompilationContext.ml | 1 + src/compiler/serverConfig.ml | 8 ++++++++ src/context/common.ml | 3 +++ src/context/display/displayException.ml | 11 +++++++---- src/context/display/displayJson.ml | 11 ++++++++++- src/syntax/parser.ml | 17 ++++++++++------- std/haxe/display/Protocol.hx | 8 ++++++++ tests/server/build.hxml | 3 ++- tests/server/src/Main.hx | 13 +++++++++++-- tests/server/src/TestCase.hx | 13 ++++++++----- tests/server/src/cases/issues/Issue10646.hx | 21 --------------------- 13 files changed, 77 insertions(+), 42 deletions(-) delete mode 100644 tests/server/src/cases/issues/Issue10646.hx diff --git a/src/compiler/compilationCache.ml b/src/compiler/compilationCache.ml index 0b4b2a0b455..984ce459e24 100644 --- a/src/compiler/compilationCache.ml +++ b/src/compiler/compilationCache.ml @@ -142,6 +142,14 @@ class cache = object(self) val native_libs : (string,cached_native_lib) Hashtbl.t = Hashtbl.create 0 val mutable tasks : (server_task PriorityQueue.t) = PriorityQueue.Empty + method clear = + Hashtbl.clear contexts; + context_list <- []; + Hashtbl.clear haxelib; + Hashtbl.clear directories; + Hashtbl.clear native_libs; + tasks <- PriorityQueue.Empty + (* contexts *) method get_context sign = diff --git a/src/compiler/server.ml b/src/compiler/server.ml index 62629092446..636c5cfe4ae 100644 --- a/src/compiler/server.ml +++ b/src/compiler/server.ml @@ -301,7 +301,7 @@ let check_module sctx com m_path m_extra p = ServerMessage.unchanged_content com "" file; end else begin ServerMessage.not_cached com "" m_path; - if m_extra.m_kind = MFake then Hashtbl.remove fake_modules (Path.UniqueKey.lazy_key m_extra.m_file); + if m_extra.m_kind = MFake then Hashtbl.remove com.fake_modules (Path.UniqueKey.lazy_key m_extra.m_file); raise (Dirty (FileChanged file)) end end diff --git a/src/compiler/serverCompilationContext.ml b/src/compiler/serverCompilationContext.ml index 393d2fa2d84..654c5dfe9b4 100644 --- a/src/compiler/serverCompilationContext.ml +++ b/src/compiler/serverCompilationContext.ml @@ -45,6 +45,7 @@ let reset sctx = Hashtbl.clear sctx.changed_directories; sctx.was_compilation <- false; Parser.reset_state(); + Lexer.cur := Lexer.make_file ""; measure_times := false; Hashtbl.clear DeprecationCheck.warned_positions; close_times(); diff --git a/src/compiler/serverConfig.ml b/src/compiler/serverConfig.ml index 173637cb401..07fbf6e1a4d 100644 --- a/src/compiler/serverConfig.ml +++ b/src/compiler/serverConfig.ml @@ -1,3 +1,11 @@ let do_not_check_modules = ref false let populate_cache_from_display = ref true let legacy_completion = ref false + +let max_completion_items = ref 0 + +let reset () = + do_not_check_modules := false; + populate_cache_from_display := true; + legacy_completion := false; + max_completion_items := 0 \ No newline at end of file diff --git a/src/context/common.ml b/src/context/common.ml index db30ae055ee..37dae49f490 100644 --- a/src/context/common.ml +++ b/src/context/common.ml @@ -398,6 +398,7 @@ type context = { overload_cache : ((path * string),(Type.t * tclass_field) list) lookup; module_lut : module_lut; module_nonexistent_lut : (path,bool) lookup; + fake_modules : (Path.UniqueKey.t,module_def) Hashtbl.t; mutable has_error : bool; pass_debug_messages : string DynArray.t; (* output *) @@ -833,6 +834,7 @@ let create compilation_step cs version args display_mode = modules = []; module_lut = new module_lut; module_nonexistent_lut = new hashtbl_lookup; + fake_modules = Hashtbl.create 0; flash_version = 10.; resources = Hashtbl.create 0; net_std = []; @@ -932,6 +934,7 @@ let clone com is_macro_context = module_to_file = new hashtbl_lookup; overload_cache = new hashtbl_lookup; module_lut = new module_lut; + fake_modules = Hashtbl.create 0; hxb_reader_stats = HxbReader.create_hxb_reader_stats (); std = null_class; empty_class_path = new ClassPath.directory_class_path "" User; diff --git a/src/context/display/displayException.ml b/src/context/display/displayException.ml index 661bb1bd17b..59c2d8d9454 100644 --- a/src/context/display/displayException.ml +++ b/src/context/display/displayException.ml @@ -18,7 +18,10 @@ let raise_package sl = raise (DisplayException(DisplayPackage sl)) (* global state *) let last_completion_result = ref (Array.make 0 (CompletionItem.make (ITModule ([],"")) None)) let last_completion_pos = ref None -let max_completion_items = ref 0 + +let reset () = + last_completion_result := (Array.make 0 (CompletionItem.make (ITModule ([],"")) None)); + last_completion_pos := None let filter_somehow ctx items kind subj = let subject = match subj.s_name with @@ -88,7 +91,7 @@ let filter_somehow ctx items kind subj = in let ret = DynArray.create () in let rec loop acc_types = match acc_types with - | (item,index,_) :: acc_types when DynArray.length ret < !max_completion_items -> + | (item,index,_) :: acc_types when DynArray.length ret < !ServerConfig.max_completion_items -> DynArray.add ret (CompletionItem.to_json ctx (Some index) item); loop acc_types | _ -> @@ -113,7 +116,7 @@ let patch_completion_subject subj = let fields_to_json ctx fields kind subj = last_completion_result := Array.of_list fields; - let needs_filtering = !max_completion_items > 0 && Array.length !last_completion_result > !max_completion_items in + let needs_filtering = !ServerConfig.max_completion_items > 0 && Array.length !last_completion_result > !ServerConfig.max_completion_items in (* let p_before = subj.s_insert_pos in *) let subj = patch_completion_subject subj in let ja,num_items = if needs_filtering then @@ -121,7 +124,7 @@ let fields_to_json ctx fields kind subj = else List.mapi (fun i item -> CompletionItem.to_json ctx (Some i) item) fields,Array.length !last_completion_result in - let did_filter = num_items = !max_completion_items in + let did_filter = num_items = !ServerConfig.max_completion_items in last_completion_pos := if did_filter then Some subj.s_start_pos else None; let filter_string = (match subj.s_name with None -> "" | Some name -> name) in (* print_endline (Printf.sprintf "FIELDS OUTPUT:\n\tfilter_string: %s\n\t num items: %i\n\t start: %s\n\t position: %s\n\t before cut: %s" diff --git a/src/context/display/displayJson.ml b/src/context/display/displayJson.ml index 0cd7f68c41f..aaebde54db2 100644 --- a/src/context/display/displayJson.ml +++ b/src/context/display/displayJson.ml @@ -167,7 +167,7 @@ let handler = let l = [ "initialize", (fun hctx -> supports_resolve := hctx.jsonrpc#get_opt_param (fun () -> hctx.jsonrpc#get_bool_param "supportsResolve") false; - DisplayException.max_completion_items := hctx.jsonrpc#get_opt_param (fun () -> hctx.jsonrpc#get_int_param "maxCompletionItems") 0; + ServerConfig.max_completion_items := hctx.jsonrpc#get_opt_param (fun () -> hctx.jsonrpc#get_int_param "maxCompletionItems") 0; let exclude = hctx.jsonrpc#get_opt_param (fun () -> hctx.jsonrpc#get_array_param "exclude") [] in DisplayToplevel.exclude := List.map (fun e -> match e with JString s -> s | _ -> die "" __LOC__) exclude; let methods = Hashtbl.fold (fun k _ acc -> (jstring k) :: acc) h [] in @@ -310,6 +310,15 @@ let handler = ) all)) ) ); + "server/resetCache", (fun hctx -> + hctx.com.cs#clear; + supports_resolve := false; + DisplayException.reset(); + ServerConfig.reset(); + hctx.send_result (jobject [ + "success", jbool true + ]); + ); "server/readClassPaths", (fun hctx -> hctx.com.callbacks#add_after_init_macros (fun () -> let cc = hctx.display#get_cs#get_context (Define.get_signature hctx.com.defines) in diff --git a/src/syntax/parser.ml b/src/syntax/parser.ml index eda1d6ab303..c379f0c49d8 100644 --- a/src/syntax/parser.ml +++ b/src/syntax/parser.ml @@ -159,6 +159,12 @@ let had_resume = ref false let code_ref = ref (Sedlexing.Utf8.from_string "") let delayed_syntax_completion : (syntax_completion * DisplayTypes.completion_subject) option ref = ref None +(* Per-file state *) + +let in_display_file = ref false +let last_doc : (string * int) option ref = ref None +let syntax_errors = ref [] + let reset_state () = in_display := false; was_auto_triggered := false; @@ -167,13 +173,10 @@ let reset_state () = in_macro := false; had_resume := false; code_ref := Sedlexing.Utf8.from_string ""; - delayed_syntax_completion := None - -(* Per-file state *) - -let in_display_file = ref false -let last_doc : (string * int) option ref = ref None -let syntax_errors = ref [] + delayed_syntax_completion := None; + in_display_file := false; + last_doc := None; + syntax_errors := [] let syntax_error_with_pos error_msg p v = let p = if p.pmax = max_int then {p with pmax = p.pmin + 1} else p in diff --git a/std/haxe/display/Protocol.hx b/std/haxe/display/Protocol.hx index 44fd5459375..beb4fc5ea4e 100644 --- a/std/haxe/display/Protocol.hx +++ b/std/haxe/display/Protocol.hx @@ -30,6 +30,14 @@ class Methods { The initialize request is sent from the client to Haxe to determine the capabilities. **/ static inline var Initialize = new HaxeRequestMethod("initialize"); + + static inline var ResetCache = new HaxeRequestMethod("server/resetCache"); +} + +typedef ResetCacheParams = {} + +typedef ResetCacheResult = { + final success:Bool; } /* Initialize */ diff --git a/tests/server/build.hxml b/tests/server/build.hxml index 5f279dfab01..04def294086 100644 --- a/tests/server/build.hxml +++ b/tests/server/build.hxml @@ -6,7 +6,8 @@ -lib utest -lib haxeserver -D analyzer-optimize -# -D UTEST_PATTERN=9087 +-D UTEST-PRINT-TESTS +#-D UTEST_PATTERN=ServerTests # or set UTEST_PATTERN environment variable #Temporary. To find out what's wrong with random CI failures diff --git a/tests/server/src/Main.hx b/tests/server/src/Main.hx index e35a4cafcbe..a12ce010406 100644 --- a/tests/server/src/Main.hx +++ b/tests/server/src/Main.hx @@ -1,6 +1,8 @@ import utest.ui.Report; import utest.Runner; import utils.Vfs; +import haxeserver.HaxeServerAsync; +import haxeserver.process.HaxeServerProcessNode; class Main { static public function main() { @@ -11,6 +13,13 @@ class Main { var report = Report.create(runner); report.displayHeader = AlwaysShowHeader; report.displaySuccessResults = NeverShowSuccessResults; - runner.run(); + var cwd = Sys.getCwd(); + var server:HaxeServerAsync = null; + runner.onComplete.add(_ -> server.stop()); + server = new HaxeServerAsync(() -> new HaxeServerProcessNode("haxe", ["-v"], {}, () -> { + TestCase.server = server; + TestCase.rootCwd = cwd; + runner.run(); + })); } -} \ No newline at end of file +} diff --git a/tests/server/src/TestCase.hx b/tests/server/src/TestCase.hx index 0d4b9d3a283..ed83696c3c0 100644 --- a/tests/server/src/TestCase.hx +++ b/tests/server/src/TestCase.hx @@ -26,7 +26,9 @@ class TestCase implements ITest { prints:Array }; - var server:HaxeServerAsync; + static public var server:HaxeServerAsync; + static public var rootCwd:String; + var vfs:Vfs; var testDir:String; var lastResult:HaxeServerRequestResult; @@ -69,15 +71,16 @@ class TestCase implements ITest { } } + @:timeout(3000) public function setup(async:utest.Async) { testDir = "test/cases/" + i++; vfs = new Vfs(testDir); - server = new HaxeServerAsync(() -> new HaxeServerProcessNode("haxe", ["-v", "--cwd", testDir], {}, () -> async.done())); + runHaxeJson(["--cwd", rootCwd, "--cwd", testDir], Methods.ResetCache, {}, () -> { + async.done(); + }); } - public function teardown() { - server.stop(); - } + public function teardown() {} function handleResult(result) { lastResult = result; diff --git a/tests/server/src/cases/issues/Issue10646.hx b/tests/server/src/cases/issues/Issue10646.hx deleted file mode 100644 index 7882f6466f4..00000000000 --- a/tests/server/src/cases/issues/Issue10646.hx +++ /dev/null @@ -1,21 +0,0 @@ -package cases.issues; - -class Issue10646 extends TestCase { - function test(_) { - vfs.putContent("HelloWorld.hx", getTemplate("HelloWorld.hx")); - var args = ["-main", "HelloWorld", "--neko", "test.n"]; - runHaxe(args); - var nekoCtx = null; - runHaxeJsonCb([], ServerMethods.Contexts, null, function(ctxs) { - for (ctx in ctxs) { - if (ctx.desc == "after_init_macros") { - nekoCtx = ctx; - } - } - }); - Assert.notNull(nekoCtx); - runHaxeJsonCb([], ServerMethods.ContextMemory, {signature: nekoCtx.signature}, function(mem) { - Assert.isNull(mem.leaks); - }); - } -} From 1242fb41e1847565aeb8192a72d0193f5e50a180 Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Mon, 5 Feb 2024 14:26:11 +0100 Subject: [PATCH 45/51] refactor create_module_type --- src/typing/typeloadModule.ml | 356 +++++++++++++++++------------------ 1 file changed, 176 insertions(+), 180 deletions(-) diff --git a/src/typing/typeloadModule.ml b/src/typing/typeloadModule.ml index 906492bcfa7..27058d58e8c 100644 --- a/src/typing/typeloadModule.ml +++ b/src/typing/typeloadModule.ml @@ -62,7 +62,17 @@ module ModuleLevel = struct *) let create_module_types ctx_m m tdecls loadp = let com = ctx_m.com in - let decls = ref [] in + let module_types = DynArray.create () in + let declarations = DynArray.create () in + let add_declaration decl tdecl = + DynArray.add declarations (decl,tdecl); + match tdecl with + | None -> + () + | Some mt -> + ctx_m.com.module_lut#add_module_type m mt; + DynArray.add module_types mt; + in let statics = ref [] in let check_name name meta also_statics p = DeprecationCheck.check_is com ctx_m.m.curmod meta [] name meta p; @@ -70,9 +80,9 @@ module ModuleLevel = struct 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)) -> + DynArray.iter (fun t2 -> if snd (t_path t2) = name then error (t_infos t2).mt_name_pos - ) !decls; + ) module_types; if also_statics then List.iter (fun (d,_) -> if fst d.d_name = name then error (snd d.d_name) @@ -83,155 +93,149 @@ module ModuleLevel = struct if priv then (fst m.m_path @ ["_" ^ snd m.m_path], name) else (fst m.m_path, name) in let has_declaration = ref false in - let rec make_decl acc decl = + let check_type_name type_name meta p = + let module_name = snd m.m_path in + if type_name <> module_name && not (Meta.has Meta.Native meta) then Naming.check_uppercase_identifier_name ctx_m.com type_name "type" p; + in + let handle_class_decl d p = + let name = fst d.d_name in + has_declaration := true; + let priv = List.mem HPrivate d.d_flags in + let path = make_path name priv d.d_meta (snd d.d_name) in + let c = mk_class m path p (pos d.d_name) in + (* we shouldn't load any other type until we propertly set cl_build *) + c.cl_build <- (fun() -> raise_typing_error (s_type_path c.cl_path ^ " is not ready to be accessed, separate your type declarations in several files") p); + c.cl_module <- m; + c.cl_private <- priv; + c.cl_doc <- d.d_doc; + c.cl_meta <- d.d_meta; + if List.mem HAbstract d.d_flags then add_class_flag c CAbstract; + List.iter (function + | HExtern -> add_class_flag c CExtern + | HInterface -> add_class_flag c CInterface + | HFinal -> add_class_flag c CFinal + | _ -> () + ) d.d_flags; + if not (has_class_flag c CExtern) then check_type_name name d.d_meta p; + if has_class_flag c CAbstract then begin + 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; + c + in + let make_decl decl = 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 Naming.check_uppercase_identifier_name ctx_m.com type_name "type" p; - in - let acc = (match fst decl with - | EImport _ | EUsing _ -> - if !has_declaration then raise_typing_error "import and using may not appear after a declaration" p; - acc - | EStatic d -> - check_name (fst d.d_name) d.d_meta false (snd d.d_name); - has_declaration := true; - statics := (d,p) :: !statics; - acc; - | EClass d -> - let name = fst d.d_name in - has_declaration := true; - let priv = List.mem HPrivate d.d_flags in - let path = make_path name priv d.d_meta (snd d.d_name) in - let c = mk_class m path p (pos d.d_name) in - (* we shouldn't load any other type until we propertly set cl_build *) - c.cl_build <- (fun() -> raise_typing_error (s_type_path c.cl_path ^ " is not ready to be accessed, separate your type declarations in several files") p); - c.cl_module <- m; - c.cl_private <- priv; - c.cl_doc <- d.d_doc; - c.cl_meta <- d.d_meta; - if List.mem HAbstract d.d_flags then add_class_flag c CAbstract; - List.iter (function - | HExtern -> add_class_flag c CExtern - | HInterface -> add_class_flag c CInterface - | HFinal -> add_class_flag c CFinal - | _ -> () - ) 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 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 - | EEnum d -> - let name = fst d.d_name in - has_declaration := true; - let priv = List.mem EPrivate d.d_flags in - let path = make_path name priv d.d_meta p in - if Meta.has (Meta.Custom ":fakeEnum") d.d_meta then raise_typing_error "@:fakeEnum enums is no longer supported in Haxe 4, use extern enum abstract instead" p; - let e = { - (mk_enum m path p (pos d.d_name)) with - e_doc = d.d_doc; - e_meta = d.d_meta; - e_private = priv; - e_extern = List.mem EExtern d.d_flags; - } in - if not e.e_extern then check_type_name name d.d_meta; - decls := (TEnumDecl e, decl) :: !decls; - acc - | ETypedef d -> - let name = fst d.d_name in - check_type_name name d.d_meta; - has_declaration := true; - let priv = List.mem EPrivate d.d_flags in - let path = make_path name priv d.d_meta p in - let t = {(mk_typedef m path p (pos d.d_name) (mk_mono())) with - t_doc = d.d_doc; - t_private = priv; - t_meta = d.d_meta; - } in - (* failsafe in case the typedef is not initialized (see #3933) *) - delay ctx_m.g PBuildModule (fun () -> - match t.t_type with - | TMono r -> (match r.tm_type with None -> Monomorph.bind r com.basic.tvoid | _ -> ()) - | _ -> () - ); - decls := (TTypeDecl t, decl) :: !decls; - acc - | EAbstract d -> - let name = fst d.d_name in - check_type_name name d.d_meta; - let priv = List.mem AbPrivate d.d_flags in - let path = make_path name priv d.d_meta p in - let p_enum_meta = Meta.maybe_get_pos Meta.Enum d.d_meta in - let a = { - a_path = path; - a_private = priv; - a_module = m; - a_pos = p; - a_name_pos = pos d.d_name; - a_doc = d.d_doc; - a_params = []; - a_using = []; - a_restore = (fun () -> ()); - a_meta = d.d_meta; - a_from = []; - a_to = []; - a_from_field = []; - a_to_field = []; - a_ops = []; - a_unops = []; - a_impl = None; - a_array = []; - a_this = mk_mono(); - a_read = None; - a_write = None; - a_call = None; - a_enum = List.mem AbEnum d.d_flags || p_enum_meta <> None; - } in - begin match p_enum_meta with - | None when a.a_enum -> a.a_meta <- (Meta.Enum,[],null_pos) :: a.a_meta; (* HAXE5: remove *) - | None -> () - | Some p -> - let options = Warning.from_meta d.d_meta in - 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 - | [] when Meta.has Meta.CoreType a.a_meta -> - a.a_this <- t_dynamic; - acc - | fields -> - let a_t = - let params = List.map (fun t -> TPType (make_ptp_th (mk_type_path ([],fst t.tp_name)) null_pos)) d.d_params in - make_ptp_ct_null (mk_type_path ~params ([],fst d.d_name)),null_pos - in - let rec loop = function - | [] -> a_t - | AbOver t :: _ -> t - | _ :: l -> loop l - in - let this_t = loop d.d_flags in - let fields = List.map (TypeloadFields.transform_abstract_field com this_t a_t a) fields in - let meta = ref [] in - if has_meta Meta.Dce a.a_meta then meta := (Meta.Dce,[],null_pos) :: !meta; - 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,_) :: _ -> + match fst decl with + | EImport _ | EUsing _ -> + if !has_declaration then raise_typing_error "import and using may not appear after a declaration" p; + add_declaration decl None + | EStatic d -> + check_name (fst d.d_name) d.d_meta false (snd d.d_name); + has_declaration := true; + statics := (d,p) :: !statics; + | EClass d -> + add_declaration decl (Some (TClassDecl (handle_class_decl d p))) + | EEnum d -> + let name = fst d.d_name in + has_declaration := true; + let priv = List.mem EPrivate d.d_flags in + let path = make_path name priv d.d_meta p in + if Meta.has (Meta.Custom ":fakeEnum") d.d_meta then raise_typing_error "@:fakeEnum enums is no longer supported in Haxe 4, use extern enum abstract instead" p; + let e = { + (mk_enum m path p (pos d.d_name)) with + e_doc = d.d_doc; + e_meta = d.d_meta; + e_private = priv; + e_extern = List.mem EExtern d.d_flags; + } in + if not e.e_extern then check_type_name name d.d_meta p; + add_declaration decl (Some (TEnumDecl e)) + | ETypedef d -> + let name = fst d.d_name in + check_type_name name d.d_meta p; + has_declaration := true; + let priv = List.mem EPrivate d.d_flags in + let path = make_path name priv d.d_meta p in + let t = {(mk_typedef m path p (pos d.d_name) (mk_mono())) with + t_doc = d.d_doc; + t_private = priv; + t_meta = d.d_meta; + } in + (* failsafe in case the typedef is not initialized (see #3933) *) + delay ctx_m.g PBuildModule (fun () -> + match t.t_type with + | TMono r -> (match r.tm_type with None -> Monomorph.bind r com.basic.tvoid | _ -> ()) + | _ -> () + ); + add_declaration decl (Some (TTypeDecl t)) + | EAbstract d -> + let name = fst d.d_name in + check_type_name name d.d_meta p; + let priv = List.mem AbPrivate d.d_flags in + let path = make_path name priv d.d_meta p in + let p_enum_meta = Meta.maybe_get_pos Meta.Enum d.d_meta in + let a = { + a_path = path; + a_private = priv; + a_module = m; + a_pos = p; + a_name_pos = pos d.d_name; + a_doc = d.d_doc; + a_params = []; + a_using = []; + a_restore = (fun () -> ()); + a_meta = d.d_meta; + a_from = []; + a_to = []; + a_from_field = []; + a_to_field = []; + a_ops = []; + a_unops = []; + a_impl = None; + a_array = []; + a_this = mk_mono(); + a_read = None; + a_write = None; + a_call = None; + a_enum = List.mem AbEnum d.d_flags || p_enum_meta <> None; + } in + begin match p_enum_meta with + | None when a.a_enum -> a.a_meta <- (Meta.Enum,[],null_pos) :: a.a_meta; (* HAXE5: remove *) + | None -> () + | Some p -> + let options = Warning.from_meta d.d_meta in + module_warning com ctx_m.m.curmod WDeprecatedEnumAbstract options "`@:enum abstract` is deprecated in favor of `enum abstract`" p + end; + add_declaration decl (Some (TAbstractDecl a)); + begin match d.d_data with + | [] when Meta.has Meta.CoreType a.a_meta -> + a.a_this <- t_dynamic; + | fields -> + let a_t = + let params = List.map (fun t -> TPType (make_ptp_th (mk_type_path ([],fst t.tp_name)) null_pos)) d.d_params in + make_ptp_ct_null (mk_type_path ~params ([],fst d.d_name)),null_pos + in + let rec loop = function + | [] -> a_t + | AbOver t :: _ -> t + | _ :: l -> loop l + in + let this_t = loop d.d_flags in + let fields = List.map (TypeloadFields.transform_abstract_field com this_t a_t a) fields in + let meta = ref [] in + if has_meta Meta.Dce a.a_meta then meta := (Meta.Dce,[],null_pos) :: !meta; + let c_decl = { 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 } in + let c = handle_class_decl c_decl p in a.a_impl <- Some c; c.cl_kind <- KAbstractImpl a; add_class_flag c CFinal; - | _ -> die "" __LOC__); - acc - ) in - decl :: acc + add_declaration (EClass c_decl,p) (Some (TClassDecl c)); + end; in - let tdecls = List.fold_left make_decl [] tdecls in - let tdecls = - match !statics with + List.iter make_decl tdecls; + begin match !statics with | [] -> - tdecls + () | statics -> let first_pos = ref null_pos in let fields = List.map (fun (d,p) -> @@ -239,7 +243,7 @@ module ModuleLevel = struct field_of_static_definition d p; ) statics in let p = let p = !first_pos in { p with pmax = p.pmin } in - let c = EClass { + let c_def = { d_name = (snd m.m_path) ^ "_Fields_", null_pos; d_flags = [HPrivate]; d_data = List.rev fields; @@ -247,19 +251,18 @@ module ModuleLevel = struct d_params = []; d_meta = [] } in - let tdecls = make_decl tdecls (c,p) in - (match !decls with - | (TClassDecl c,_) :: _ -> - assert (m.m_statics = None); - m.m_statics <- Some c; - c.cl_kind <- KModuleFields m; - add_class_flag c CFinal; - | _ -> assert false); - tdecls - - in - let decls = List.rev !decls in - decls, List.rev tdecls + let c = handle_class_decl c_def p in + assert (m.m_statics = None); + m.m_statics <- Some c; + c.cl_kind <- KModuleFields m; + add_class_flag c CFinal; + add_declaration (EClass c_def,p) (Some (TClassDecl c)); + end; + (* 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. *) + m.m_types <- m.m_types @ (DynArray.to_list module_types); + DynArray.to_list declarations 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 @@ -312,7 +315,7 @@ module ModuleLevel = struct 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)) -> + | (EClass d, p),Some (TClassDecl c) -> 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.GenericBuild c.cl_meta then begin @@ -320,12 +323,14 @@ module ModuleLevel = struct 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)) -> + | ((EEnum d, p),Some (TEnumDecl e)) -> e.e_params <- type_type_params ctx_m TPHType e.e_path p d.d_params; - | (TTypeDecl t, (ETypedef d, p)) -> + | ((ETypedef d, p),Some (TTypeDecl t)) -> t.t_params <- type_type_params ctx_m TPHType t.t_path p d.d_params; - | (TAbstractDecl a, (EAbstract d, p)) -> + | ((EAbstract d, p),Some (TAbstractDecl a)) -> a.a_params <- type_type_params ctx_m TPHType a.a_path p d.d_params; + | (((EImport _ | EUsing _),_),None) -> + () | _ -> die "" __LOC__ ) decls @@ -641,11 +646,8 @@ module TypeLevel = struct 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_m (decl,p) = + let init_module_type ctx_m ((decl,p),tdecl) = let com = ctx_m.com in - let get_type name = - 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 (com.file_keys#get p.pfile) then DisplayPath.handle_path_display ctx_m path p in @@ -662,16 +664,16 @@ module TypeLevel = struct check_path_display 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 + let c = (match tdecl with Some (TClassDecl c) -> c | _ -> die "" __LOC__) in 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 + let e = (match tdecl with Some (TEnumDecl e) -> e | _ -> die "" __LOC__) in 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 + let t = (match tdecl with Some (TTypeDecl t) -> t | _ -> die "" __LOC__) in 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 + let a = (match tdecl with Some (TAbstractDecl a) -> a | _ -> die "" __LOC__) in init_abstract ctx_m a d p | EStatic _ -> (* nothing to do here as module fields are collected into a special EClass *) @@ -698,13 +700,7 @@ let make_curmod com g m = *) let type_types_into_module com g m tdecls p = let ctx_m = TyperManager.clone_for_module g.root_typer (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_m.com.module_lut#add_module_type m mt) types; - m.m_types <- m.m_types @ types; + let decls = ModuleLevel.create_module_types ctx_m m tdecls p in (* define the per-module context for the next pass *) if ctx_m.g.std_types != null_module then begin add_dependency m ctx_m.g.std_types; @@ -713,7 +709,7 @@ let type_types_into_module com g m tdecls p = end; ModuleLevel.init_type_params ctx_m decls; (* setup module types *) - List.iter (TypeLevel.init_module_type ctx_m) tdecls; + List.iter (TypeLevel.init_module_type ctx_m) decls; (* Make sure that we actually init the context at some point (issue #9012) *) delay ctx_m.g PConnectField (fun () -> ctx_m.m.import_resolution#resolve_lazies); ctx_m From dbc9952adf5a7ab30c430ddca0428313dbb1e376 Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Tue, 6 Feb 2024 12:01:01 +0100 Subject: [PATCH 46/51] don't double-throw all exceptions closes #11175 --- src/filters/exceptions.ml | 2 +- tests/optimization/src/issues/Issue11175.hx | 11 +++++++++++ 2 files changed, 12 insertions(+), 1 deletion(-) create mode 100644 tests/optimization/src/issues/Issue11175.hx diff --git a/src/filters/exceptions.ml b/src/filters/exceptions.ml index 1429260aa60..e66758e088c 100644 --- a/src/filters/exceptions.ml +++ b/src/filters/exceptions.ml @@ -179,7 +179,7 @@ let throw_native ctx e_thrown t p = else e_thrown in - mk (TThrow e_native) t p + e_native let set_needs_exception_stack v = if not (Meta.has Meta.NeedsExceptionStack v.v_meta) then diff --git a/tests/optimization/src/issues/Issue11175.hx b/tests/optimization/src/issues/Issue11175.hx new file mode 100644 index 00000000000..124d9ed983e --- /dev/null +++ b/tests/optimization/src/issues/Issue11175.hx @@ -0,0 +1,11 @@ +package issues; + +class Issue11175 { + @:js(' + throw haxe_Exception.thrown("foo"); + ') + @:analyzer(ignore) + static function test() { + throw "foo"; + } +} \ No newline at end of file From 2dfc0d920b943b8c0640da4a54d00ebf4a7e2d77 Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Tue, 6 Feb 2024 12:10:33 +0100 Subject: [PATCH 47/51] Remove C# and Java targets (#11551) * remove generators and gencommon * remove C# target * remove ilib * remove C# std * remove C# from tests * disable Java tests too * remove from docgen * remove Java target * remove javalib * purge ilib and javalib * disable Java-specific test * fix merge mixhaps * remove C# tests again * fix some tests * annoying * also annoying * one more * still install format * fix * more fix * bring back gitkeep and delete more stuff * Remove unused std files Or at least shouldn't be used... * Update docgen * That can't be used anymore * Keep hxjava * Leftovers * [ci] update workflow sources * [tests] update special handling * [docgen] whoops * More special handling removal * Might be very old, but still seems to apply to jvm too.. * They are everywhere... * What the hell was that? * Remove more... * Remove even more... * Fix platform * Warnings * [ci] break jvm * [tests] Sockets don't seem to be implemented for jvm * [tests] Fix Simon's favorite test again * Remove java.internal.StringExt * Remove more java internals * That's not a target anymore * Forget about cs * Warnings * [typer] don't type trailing optional bind arguments so weirdly see #11531 * [tests] jvm is not ready for this one yet * Use -jvm * More --jvm/-jvm arg stuff * Fix -jvm... * Output jar files * jvm is now a reserved define --------- Co-authored-by: Rudy Ges --- .github/workflows/main.yml | 10 +- .vscode/schemas/meta.schema.json | 3 +- Earthfile | 13 - Makefile | 1 - README.md | 2 - extra/ImportAll.hx | 9 +- extra/all.hxml | 9 - extra/doc.hxml | 9 +- extra/github-actions/workflows/main.yml | 10 +- extra/release-checklist.txt | 2 +- libs/ilib/Makefile | 26 - libs/ilib/dump.ml | 38 - libs/ilib/dune | 15 - libs/ilib/ilData.mli | 115 - libs/ilib/ilMeta.mli | 1204 ------ libs/ilib/ilMetaDebug.ml | 24 - libs/ilib/ilMetaReader.ml | 2406 ----------- libs/ilib/ilMetaTools.ml | 472 --- libs/ilib/ilMetaWriter.ml | 78 - libs/ilib/peData.ml | 548 --- libs/ilib/peDataDebug.ml | 186 - libs/ilib/peReader.ml | 495 --- libs/ilib/peWriter.ml | 160 - libs/javalib/Makefile | 22 - libs/javalib/dune | 13 - libs/javalib/jData.ml | 267 -- libs/javalib/jReader.ml | 646 --- libs/javalib/jWriter.ml | 299 -- src-json/define.json | 121 +- src-json/meta.json | 211 +- src-prebuild/prebuild.ml | 3 +- src/codegen/dotnet.ml | 1322 ------ .../gencommon/abstractImplementationFix.ml | 43 - src/codegen/gencommon/arrayDeclSynf.ml | 51 - .../gencommon/arraySpliceOptimization.ml | 40 - src/codegen/gencommon/castDetect.ml | 1348 ------- src/codegen/gencommon/classInstance.ml | 57 - src/codegen/gencommon/closuresToClass.ml | 1181 ------ src/codegen/gencommon/dynamicFieldAccess.ml | 132 - src/codegen/gencommon/dynamicOperators.ml | 189 - src/codegen/gencommon/enumToClass.ml | 301 -- src/codegen/gencommon/enumToClass2.ml | 398 -- src/codegen/gencommon/expressionUnwrap.ml | 650 --- src/codegen/gencommon/filterClosures.ml | 86 - src/codegen/gencommon/fixOverrides.ml | 275 -- src/codegen/gencommon/gencommon.ml | 1365 ------- src/codegen/gencommon/hardNullableSynf.ml | 284 -- src/codegen/gencommon/initFunction.ml | 238 -- src/codegen/gencommon/intDivisionSynf.ml | 86 - src/codegen/gencommon/interfaceProps.ml | 43 - .../gencommon/interfaceVarsDeleteModf.ml | 84 - src/codegen/gencommon/normalize.ml | 100 - src/codegen/gencommon/objectDeclMap.ml | 37 - .../gencommon/overloadingConstructor.ml | 458 --- src/codegen/gencommon/realTypeParams.ml | 786 ---- src/codegen/gencommon/reflectionCFs.ml | 1542 ------- src/codegen/gencommon/renameTypeParameters.ml | 95 - src/codegen/gencommon/setHXGen.ml | 101 - src/codegen/gencommon/switchToIf.ml | 167 - src/codegen/gencommon/tArrayTransform.ml | 104 - .../gencommon/unnecessaryCastsRemoval.ml | 64 - .../unreachableCodeEliminationSynf.ml | 219 - src/codegen/jClass.ml | 79 + src/codegen/java.ml | 1281 ------ src/codegen/javaModern.ml | 16 + src/compiler/args.ml | 21 +- src/compiler/compilationContext.ml | 1 - src/compiler/compiler.ml | 17 +- src/compiler/generate.ml | 12 +- src/context/common.ml | 61 +- src/context/display/displayPath.ml | 1 - src/context/nativeLibraries.ml | 5 +- src/context/nativeLibraryHandler.ml | 14 +- src/core/globals.ml | 12 +- src/dune | 2 +- src/filters/capturedVars.ml | 18 +- src/filters/exceptions.ml | 2 +- src/filters/filters.ml | 86 +- src/generators/gencs.ml | 3562 ----------------- src/generators/genjava.ml | 2711 ------------- src/macro/macroApi.ml | 23 +- src/optimization/analyzerConfig.ml | 2 +- src/optimization/analyzerTexpr.ml | 11 +- src/optimization/inline.ml | 25 +- src/optimization/optimizer.ml | 3 +- src/typing/fields.ml | 7 +- src/typing/generic.ml | 1 - src/typing/strictMeta.ml | 68 +- src/typing/typeload.ml | 2 +- src/typing/typeloadCheck.ml | 5 +- src/typing/typeloadFields.ml | 21 +- src/typing/typeloadModule.ml | 11 +- src/typing/typer.ml | 39 +- std/StdTypes.hx | 2 +- std/StringTools.hx | 41 +- std/Sys.hx | 2 - std/UInt.hx | 6 +- std/cs/Boot.hx | 49 - std/cs/Constraints.hx | 55 - std/cs/Flags.hx | 114 - std/cs/Lib.hx | 296 -- std/cs/NativeArray.hx | 78 - std/cs/Out.hx | 33 - std/cs/Pointer.hx | 133 - std/cs/Ref.hx | 32 - std/cs/StdTypes.hx | 153 - std/cs/Syntax.hx | 56 - std/cs/_std/Array.hx | 479 --- std/cs/_std/Date.hx | 162 - std/cs/_std/EReg.hx | 135 - std/cs/_std/Math.hx | 134 - std/cs/_std/Reflect.hx | 162 - std/cs/_std/Std.hx | 214 - std/cs/_std/String.hx | 67 - std/cs/_std/StringBuf.hx | 60 - std/cs/_std/Sys.hx | 174 - std/cs/_std/Type.hx | 344 -- std/cs/_std/haxe/Exception.hx | 118 - std/cs/_std/haxe/Int64.hx | 242 -- std/cs/_std/haxe/NativeStackTrace.hx | 60 - std/cs/_std/haxe/Resource.hx | 70 - std/cs/_std/haxe/Rest.hx | 60 - std/cs/_std/haxe/atomic/AtomicInt.hx | 61 - std/cs/_std/haxe/atomic/AtomicObject.hx | 33 - std/cs/_std/haxe/ds/IntMap.hx | 528 --- std/cs/_std/haxe/ds/ObjectMap.hx | 539 --- std/cs/_std/haxe/ds/StringMap.hx | 531 --- std/cs/_std/sys/FileSystem.hx | 125 - std/cs/_std/sys/io/File.hx | 95 - std/cs/_std/sys/io/FileInput.hx | 29 - std/cs/_std/sys/io/FileOutput.hx | 29 - std/cs/_std/sys/io/Process.hx | 127 - std/cs/_std/sys/net/Host.hx | 75 - std/cs/_std/sys/net/Socket.hx | 190 - std/cs/_std/sys/net/UdpSocket.hx | 99 - std/cs/_std/sys/thread/Condition.hx | 37 - std/cs/_std/sys/thread/Deque.hx | 60 - std/cs/_std/sys/thread/Lock.hx | 79 - std/cs/_std/sys/thread/Mutex.hx | 43 - std/cs/_std/sys/thread/Semaphore.hx | 22 - std/cs/_std/sys/thread/Thread.hx | 184 - std/cs/_std/sys/thread/Tls.hx | 45 - std/cs/internal/BoxedPointer.hx | 31 - std/cs/internal/FieldLookup.hx | 311 -- std/cs/internal/Function.hx | 79 - std/cs/internal/HxObject.hx | 317 -- std/cs/internal/Null.hx | 88 - std/cs/internal/Runtime.hx | 712 ---- std/cs/internal/StringExt.hx | 223 -- std/cs/io/NativeInput.hx | 94 - std/cs/io/NativeOutput.hx | 74 - std/cs/types/Char16.hx | 25 - std/cs/types/Int16.hx | 25 - std/cs/types/Int64.hx | 25 - std/cs/types/Int8.hx | 25 - std/cs/types/UInt16.hx | 25 - std/cs/types/UInt64.hx | 25 - std/cs/types/UInt8.hx | 25 - std/haxe/Serializer.hx | 22 +- std/haxe/crypto/Md5.hx | 8 +- std/haxe/display/Display.hx | 1 - std/haxe/ds/IntMap.hx | 4 +- std/haxe/ds/ObjectMap.hx | 4 +- std/haxe/ds/StringMap.hx | 4 +- std/haxe/ds/Vector.hx | 22 +- std/haxe/io/Bytes.hx | 32 +- std/haxe/io/BytesBuffer.hx | 15 - std/haxe/io/BytesData.hx | 2 - std/haxe/io/BytesInput.hx | 9 - std/haxe/io/FPHelper.hx | 72 +- std/haxe/io/Input.hx | 4 +- std/haxe/macro/Compiler.hx | 12 +- std/haxe/rtti/Meta.hx | 4 +- std/java/Boot.hx | 6 - std/java/_std/EReg.hx | 192 - std/java/_std/Reflect.hx | 145 - std/java/_std/Std.hx | 199 - std/java/_std/String.hx | 58 - std/java/_std/StringBuf.hx | 59 - std/java/_std/Type.hx | 370 -- std/java/_std/haxe/Rest.hx | 118 - std/java/_std/haxe/ds/StringMap.hx | 533 --- std/java/_std/sys/thread/Lock.hx | 78 - std/java/internal/FieldLookup.hx | 110 - std/java/internal/Function.hx | 82 - std/java/internal/HxObject.hx | 297 -- std/java/internal/IEquatable.hx | 30 - std/java/internal/Runtime.hx | 598 --- std/java/internal/StringExt.hx | 253 -- std/jvm/_std/haxe/Rest.hx | 1 + tests/README.md | 2 +- tests/RunCi.hx | 4 - tests/misc/README.md | 2 +- tests/misc/cs/csTwoLibs/.gitignore | 1 - tests/misc/cs/csTwoLibs/Lib1.hx | 7 - tests/misc/cs/csTwoLibs/Main.hx | 22 - tests/misc/cs/csTwoLibs/compile-1.hxml | 17 - tests/misc/cs/csTwoLibs/compile-2.hxml | 20 - tests/misc/cs/csTwoLibs/compile-3.hxml | 20 - tests/misc/cs/csTwoLibs/compile-4.hxml | 23 - tests/misc/cs/projects/Issue11350/Main.hx | 10 - .../misc/cs/projects/Issue11350/compile.hxml | 3 - tests/misc/cs/projects/Issue3526/.gitignore | 1 - .../Issue3526/IncompatibleCombinations.hx | 28 - tests/misc/cs/projects/Issue3526/Main.hx | 72 - .../cs/projects/Issue3526/compile-7.3.hxml | 4 - tests/misc/cs/projects/Issue3526/compile.hxml | 2 - .../incompatible-combinations-fail.hxml | 4 - ...incompatible-combinations-fail.hxml.stderr | 8 - tests/misc/cs/projects/Issue3703/Main.hx | 15 - tests/misc/cs/projects/Issue3703/Test.hx | 15 - tests/misc/cs/projects/Issue3703/compile.hxml | 3 - tests/misc/cs/projects/Issue4002/Main.hx | 19 - tests/misc/cs/projects/Issue4002/compile.hxml | 3 - tests/misc/cs/projects/Issue4116/.gitignore | 1 - tests/misc/cs/projects/Issue4116/base/A.hx | 3 - tests/misc/cs/projects/Issue4116/compile.hxml | 2 - tests/misc/cs/projects/Issue4598/Main.hx | 16 - tests/misc/cs/projects/Issue4598/Run.hx | 11 - tests/misc/cs/projects/Issue4598/compile.hxml | 4 - tests/misc/cs/projects/Issue4623/Main.hx | 59 - tests/misc/cs/projects/Issue4623/Run.hx | 11 - tests/misc/cs/projects/Issue4623/compile.hxml | 4 - tests/misc/cs/projects/Issue5434/Main.hx | 6 - tests/misc/cs/projects/Issue5434/compile.hxml | 2 - tests/misc/cs/projects/Issue5915/Test.hx | 20 - tests/misc/cs/projects/Issue5915/compile.hxml | 2 - tests/misc/cs/projects/Issue5953/Main.hx | 17 - tests/misc/cs/projects/Issue5953/Reduced.hx | 10 - tests/misc/cs/projects/Issue5953/compile.hxml | 3 - tests/misc/cs/projects/Issue6635/Main.hx | 13 - tests/misc/cs/projects/Issue6635/compile.hxml | 3 - .../cs/projects/Issue6635/compile.hxml.stderr | 0 tests/misc/cs/projects/Issue7875/Main.hx | 23 - tests/misc/cs/projects/Issue7875/compile.hxml | 3 - tests/misc/cs/projects/Issue8347/.gitignore | 2 - tests/misc/cs/projects/Issue8347/Main.hx | 7 - .../cs/projects/Issue8347/compile-fail.hxml | 5 - .../Issue8347/compile-fail.hxml.stderr | 4 - tests/misc/cs/projects/Issue8347/compile.hxml | 3 - .../Issue8347/src/fail/NotFirstType.hx | 9 - .../cs/projects/Issue8347/src/pack/Main.hx | 7 - tests/misc/cs/projects/Issue8361/Main.hx | 22 - tests/misc/cs/projects/Issue8361/compile.hxml | 2 - tests/misc/cs/projects/Issue8366/Main.hx | 22 - tests/misc/cs/projects/Issue8366/compile.hxml | 3 - tests/misc/cs/projects/Issue8487/Main1.hx | 6 - tests/misc/cs/projects/Issue8487/Main2.hx | 8 - .../cs/projects/Issue8487/compile-fail.hxml | 2 - .../Issue8487/compile-fail.hxml.stderr | 1 - tests/misc/cs/projects/Issue8487/compile.hxml | 2 - tests/misc/cs/projects/Issue8589/Main.hx | 10 - tests/misc/cs/projects/Issue8589/compile.hxml | 3 - .../cs/projects/Issue8589/compile.hxml.stderr | 0 tests/misc/cs/projects/Issue8664/Main.hx | 25 - tests/misc/cs/projects/Issue8664/compile.hxml | 2 - tests/misc/cs/projects/Issue9799/Main.hx | 23 - tests/misc/cs/projects/Issue9799/compile.hxml | 2 - tests/misc/cs/run.hxml | 2 - tests/misc/eventLoop/all.hxml | 4 +- .../projects/Issue11095/compile-fail.hxml | 2 +- .../java/projects/Issue2689/compile-fail.hxml | 4 +- tests/misc/java/projects/Issue8322/Main.hx | 7 - .../misc/java/projects/Issue8322/compile.hxml | 3 - .../misc/java/projects/Issue8444/compile.hxml | 2 +- .../misc/java/projects/Issue9799/compile.hxml | 2 +- ...-defined-meta-json-pretty-fail.hxml.stderr | 12 + .../Issue10871/Compiler/compile1.hxml.stdout | 1 - .../Issue10871/Compiler/compile2.hxml.stdout | 1 - .../Issue10871/Compiler/compile3.hxml.stdout | 3 +- .../{Issue5002 => issue5002}/Macro.hx | 0 .../projects/{Issue5002 => issue5002}/Main.hx | 0 .../{Issue5002 => issue5002}/Main2.hx | 0 .../{Issue5002 => issue5002}/Main3.hx | 0 .../{Issue5002 => issue5002}/Main4.hx | 0 .../compile-fail.hxml | 0 .../compile-fail.hxml.stderr | 0 .../compile2-fail.hxml | 0 .../compile2-fail.hxml.stderr | 0 .../compile3-fail.hxml | 0 .../compile3-fail.hxml.stderr | 0 .../compile4-fail.hxml | 0 .../compile4-fail.hxml.stderr | 0 tests/misc/weakmap/compile-cs.hxml | 3 - tests/misc/weakmap/compile-java.hxml | 2 +- tests/runci/TestTarget.hx | 2 - tests/runci/targets/Cs.hx | 84 - tests/runci/targets/Java.hx | 48 - tests/runci/targets/Js.hx | 2 +- tests/runci/targets/Jvm.hx | 8 +- tests/server/src/cases/ServerTests.hx | 14 +- tests/sys/compile-cs.hxml | 18 - tests/sys/compile-java.hxml | 18 - tests/sys/compile.hxml | 3 +- tests/sys/gen_test_res.py | 2 - tests/sys/run.hxml | 2 - tests/sys/src/ExitCode.hx | 12 - tests/sys/src/FileNames.hx | 2 +- tests/sys/src/TestArguments.hx | 12 - tests/sys/src/TestCommandBase.hx | 16 - tests/sys/src/TestSys.hx | 16 +- tests/sys/src/TestUnicode.hx | 34 +- tests/sys/src/UtilityProcess.hx | 30 - tests/unit/compile-cs-unsafe.hxml | 10 - tests/unit/compile-cs.hxml | 9 - tests/unit/compile-exe-runner.hxml | 3 - tests/unit/compile-java-runner.hxml | 3 - tests/unit/compile-java.hxml | 10 - tests/unit/compile.hxml | 15 +- tests/unit/native_cs/hxcs_build.txt | 28 - tests/unit/native_cs/src/NoPackage.cs | 21 - .../src/haxe/test/AttrWithNullType.cs | 17 - tests/unit/native_cs/src/haxe/test/Base.cs | 167 - .../unit/native_cs/src/haxe/test/Generic1.cs | 39 - .../native_cs/src/haxe/test/GenericHelper.cs | 14 - tests/unit/native_cs/src/haxe/test/MyClass.cs | 90 - .../src/haxe/test/OverloadInterface1.cs | 9 - .../src/haxe/test/OverloadInterface2.cs | 9 - .../src/haxe/test/StaticAndInstanceClash.cs | 36 - tests/unit/native_cs/src/haxe/test/TEnum.cs | 9 - .../native_cs/src/haxe/test/TEnumWithValue.cs | 33 - tests/unit/src/RunCastGenerator.hx | 2 +- tests/unit/src/unit/MyClass.hx | 4 +- tests/unit/src/unit/TestCSharp.hx | 840 ---- .../src/unit/TestConstrainedMonomorphs.hx | 6 +- tests/unit/src/unit/TestDCE.hx | 2 +- tests/unit/src/unit/TestExceptions.hx | 8 +- tests/unit/src/unit/TestInterface.hx | 4 +- tests/unit/src/unit/TestJava.hx | 2 +- tests/unit/src/unit/TestMain.hx | 11 +- tests/unit/src/unit/TestMisc.hx | 13 +- tests/unit/src/unit/TestNullCoalescing.hx | 2 - tests/unit/src/unit/TestNumericCasts.hx | 2 +- tests/unit/src/unit/TestOverloads.hx | 8 +- tests/unit/src/unit/TestReflect.hx | 4 +- tests/unit/src/unit/TestSyntaxModule.hx | 6 +- tests/unit/src/unit/TestType.hx | 2 +- tests/unit/src/unit/issues/Issue10143.hx | 4 +- tests/unit/src/unit/issues/Issue10145.hx | 5 - tests/unit/src/unit/issues/Issue10193.hx | 4 +- tests/unit/src/unit/issues/Issue10508.hx | 2 +- tests/unit/src/unit/issues/Issue10571.hx | 2 +- tests/unit/src/unit/issues/Issue10618.hx | 2 +- tests/unit/src/unit/issues/Issue10761.hx | 2 - tests/unit/src/unit/issues/Issue10906.hx | 2 - tests/unit/src/unit/issues/Issue11010.hx | 2 +- tests/unit/src/unit/issues/Issue1925.hx | 16 +- tests/unit/src/unit/issues/Issue2049.hx | 8 +- tests/unit/src/unit/issues/Issue2648.hx | 4 +- tests/unit/src/unit/issues/Issue2688.hx | 4 +- tests/unit/src/unit/issues/Issue2754.hx | 2 +- tests/unit/src/unit/issues/Issue2772.hx | 2 +- tests/unit/src/unit/issues/Issue2776.hx | 4 +- tests/unit/src/unit/issues/Issue2861.hx | 2 +- tests/unit/src/unit/issues/Issue2927.hx | 7 +- tests/unit/src/unit/issues/Issue3084.hx | 2 +- tests/unit/src/unit/issues/Issue3138.hx | 8 +- tests/unit/src/unit/issues/Issue3171.hx | 4 +- tests/unit/src/unit/issues/Issue3173.hx | 8 +- tests/unit/src/unit/issues/Issue3306.hx | 4 +- tests/unit/src/unit/issues/Issue3383.hx | 29 - tests/unit/src/unit/issues/Issue3396.hx | 4 - tests/unit/src/unit/issues/Issue3400.hx | 4 +- tests/unit/src/unit/issues/Issue3558.hx | 37 - tests/unit/src/unit/issues/Issue3575.hx | 6 +- tests/unit/src/unit/issues/Issue3579.hx | 2 +- tests/unit/src/unit/issues/Issue3637.hx | 5 +- tests/unit/src/unit/issues/Issue3639.hx | 7 +- tests/unit/src/unit/issues/Issue3771.hx | 12 - tests/unit/src/unit/issues/Issue3818.hx | 2 +- tests/unit/src/unit/issues/Issue3826.hx | 2 +- tests/unit/src/unit/issues/Issue3842.hx | 4 +- tests/unit/src/unit/issues/Issue3894.hx | 4 +- tests/unit/src/unit/issues/Issue3946.hx | 12 - tests/unit/src/unit/issues/Issue3949.hx | 40 - tests/unit/src/unit/issues/Issue3979.hx | 6 +- tests/unit/src/unit/issues/Issue3987.hx | 2 +- tests/unit/src/unit/issues/Issue4000.hx | 6 +- tests/unit/src/unit/issues/Issue4045.hx | 45 - tests/unit/src/unit/issues/Issue4203.hx | 2 +- tests/unit/src/unit/issues/Issue4526.hx | 4 +- tests/unit/src/unit/issues/Issue5025.hx | 4 +- .../src/unit/issues/Issue5110.hx.disabled | 18 - tests/unit/src/unit/issues/Issue5399.hx | 19 - tests/unit/src/unit/issues/Issue5505.hx | 2 +- tests/unit/src/unit/issues/Issue5507.hx | 2 +- tests/unit/src/unit/issues/Issue5747.hx | 10 - tests/unit/src/unit/issues/Issue5751.hx | 12 - tests/unit/src/unit/issues/Issue5862.hx | 40 +- tests/unit/src/unit/issues/Issue6039.hx | 31 - tests/unit/src/unit/issues/Issue6145.hx | 4 +- tests/unit/src/unit/issues/Issue6276.hx | 2 - tests/unit/src/unit/issues/Issue6291.hx | 4 +- tests/unit/src/unit/issues/Issue6379.hx | 5 +- tests/unit/src/unit/issues/Issue6482.hx | 4 +- tests/unit/src/unit/issues/Issue6784.hx | 10 - tests/unit/src/unit/issues/Issue6871.hx | 4 +- tests/unit/src/unit/issues/Issue6942.hx | 4 +- tests/unit/src/unit/issues/Issue7599.hx | 6 +- tests/unit/src/unit/issues/Issue7736.hx | 2 - tests/unit/src/unit/issues/Issue8978.hx | 25 - tests/unit/src/unit/issues/Issue8979.hx | 24 - tests/unit/src/unit/issues/Issue9034.hx | 4 +- tests/unit/src/unit/issues/Issue9217.hx | 4 +- tests/unit/src/unit/issues/Issue9220.hx | 4 +- tests/unit/src/unit/issues/Issue9438.hx | 4 +- tests/unit/src/unit/issues/Issue9601.hx | 2 +- tests/unit/src/unit/issues/Issue9619.hx | 6 +- tests/unit/src/unit/issues/Issue9738.hx | 18 - tests/unit/src/unit/issues/Issue9744.hx | 3 - tests/unit/src/unit/issues/Issue9746.hx | 11 +- tests/unit/src/unit/issues/Issue9791.hx | 6 +- tests/unit/src/unit/issues/Issue9854.hx | 3 +- tests/unit/src/unit/issues/Issue9946.hx | 30 - tests/unit/src/unitstd/Map.unit.hx | 4 - tests/unit/src/unitstd/StringTools.unit.hx | 4 +- tests/unit/src/unitstd/Type.unit.hx | 2 - .../src/unitstd/haxe/Http.unit.hx.disabled | 2 - tests/unit/src/unitstd/haxe/ds/Vector.unit.hx | 4 +- .../unit/src/unitstd/haxe/ds/WeakMap.unit.hx | 4 +- .../src/unitstd/haxe/zip/Compress.unit.hx | 4 +- .../src/unitstd/haxe/zip/Uncompress.unit.hx | 6 +- tests/unit/src/unitstd/sys/net/Socket.unit.hx | 4 +- 423 files changed, 472 insertions(+), 42013 deletions(-) delete mode 100644 libs/ilib/Makefile delete mode 100644 libs/ilib/dump.ml delete mode 100644 libs/ilib/dune delete mode 100644 libs/ilib/ilData.mli delete mode 100644 libs/ilib/ilMeta.mli delete mode 100644 libs/ilib/ilMetaDebug.ml delete mode 100644 libs/ilib/ilMetaReader.ml delete mode 100644 libs/ilib/ilMetaTools.ml delete mode 100644 libs/ilib/ilMetaWriter.ml delete mode 100644 libs/ilib/peData.ml delete mode 100644 libs/ilib/peDataDebug.ml delete mode 100644 libs/ilib/peReader.ml delete mode 100644 libs/ilib/peWriter.ml delete mode 100644 libs/javalib/Makefile delete mode 100644 libs/javalib/dune delete mode 100644 libs/javalib/jData.ml delete mode 100644 libs/javalib/jReader.ml delete mode 100644 libs/javalib/jWriter.ml delete mode 100644 src/codegen/dotnet.ml delete mode 100644 src/codegen/gencommon/abstractImplementationFix.ml delete mode 100644 src/codegen/gencommon/arrayDeclSynf.ml delete mode 100644 src/codegen/gencommon/arraySpliceOptimization.ml delete mode 100644 src/codegen/gencommon/castDetect.ml delete mode 100644 src/codegen/gencommon/classInstance.ml delete mode 100644 src/codegen/gencommon/closuresToClass.ml delete mode 100644 src/codegen/gencommon/dynamicFieldAccess.ml delete mode 100644 src/codegen/gencommon/dynamicOperators.ml delete mode 100644 src/codegen/gencommon/enumToClass.ml delete mode 100644 src/codegen/gencommon/enumToClass2.ml delete mode 100644 src/codegen/gencommon/expressionUnwrap.ml delete mode 100644 src/codegen/gencommon/filterClosures.ml delete mode 100644 src/codegen/gencommon/fixOverrides.ml delete mode 100644 src/codegen/gencommon/gencommon.ml delete mode 100644 src/codegen/gencommon/hardNullableSynf.ml delete mode 100644 src/codegen/gencommon/initFunction.ml delete mode 100644 src/codegen/gencommon/intDivisionSynf.ml delete mode 100644 src/codegen/gencommon/interfaceProps.ml delete mode 100644 src/codegen/gencommon/interfaceVarsDeleteModf.ml delete mode 100644 src/codegen/gencommon/normalize.ml delete mode 100644 src/codegen/gencommon/objectDeclMap.ml delete mode 100644 src/codegen/gencommon/overloadingConstructor.ml delete mode 100644 src/codegen/gencommon/realTypeParams.ml delete mode 100644 src/codegen/gencommon/reflectionCFs.ml delete mode 100644 src/codegen/gencommon/renameTypeParameters.ml delete mode 100644 src/codegen/gencommon/setHXGen.ml delete mode 100644 src/codegen/gencommon/switchToIf.ml delete mode 100644 src/codegen/gencommon/tArrayTransform.ml delete mode 100644 src/codegen/gencommon/unnecessaryCastsRemoval.ml delete mode 100644 src/codegen/gencommon/unreachableCodeEliminationSynf.ml create mode 100644 src/codegen/jClass.ml delete mode 100644 src/codegen/java.ml delete mode 100644 src/generators/gencs.ml delete mode 100644 src/generators/genjava.ml delete mode 100644 std/cs/Boot.hx delete mode 100644 std/cs/Constraints.hx delete mode 100644 std/cs/Flags.hx delete mode 100644 std/cs/Lib.hx delete mode 100644 std/cs/NativeArray.hx delete mode 100644 std/cs/Out.hx delete mode 100644 std/cs/Pointer.hx delete mode 100644 std/cs/Ref.hx delete mode 100644 std/cs/StdTypes.hx delete mode 100644 std/cs/Syntax.hx delete mode 100644 std/cs/_std/Array.hx delete mode 100644 std/cs/_std/Date.hx delete mode 100644 std/cs/_std/EReg.hx delete mode 100644 std/cs/_std/Math.hx delete mode 100644 std/cs/_std/Reflect.hx delete mode 100644 std/cs/_std/Std.hx delete mode 100644 std/cs/_std/String.hx delete mode 100644 std/cs/_std/StringBuf.hx delete mode 100644 std/cs/_std/Sys.hx delete mode 100644 std/cs/_std/Type.hx delete mode 100644 std/cs/_std/haxe/Exception.hx delete mode 100644 std/cs/_std/haxe/Int64.hx delete mode 100644 std/cs/_std/haxe/NativeStackTrace.hx delete mode 100644 std/cs/_std/haxe/Resource.hx delete mode 100644 std/cs/_std/haxe/Rest.hx delete mode 100644 std/cs/_std/haxe/atomic/AtomicInt.hx delete mode 100644 std/cs/_std/haxe/atomic/AtomicObject.hx delete mode 100644 std/cs/_std/haxe/ds/IntMap.hx delete mode 100644 std/cs/_std/haxe/ds/ObjectMap.hx delete mode 100644 std/cs/_std/haxe/ds/StringMap.hx delete mode 100644 std/cs/_std/sys/FileSystem.hx delete mode 100644 std/cs/_std/sys/io/File.hx delete mode 100644 std/cs/_std/sys/io/FileInput.hx delete mode 100644 std/cs/_std/sys/io/FileOutput.hx delete mode 100644 std/cs/_std/sys/io/Process.hx delete mode 100644 std/cs/_std/sys/net/Host.hx delete mode 100644 std/cs/_std/sys/net/Socket.hx delete mode 100644 std/cs/_std/sys/net/UdpSocket.hx delete mode 100644 std/cs/_std/sys/thread/Condition.hx delete mode 100644 std/cs/_std/sys/thread/Deque.hx delete mode 100644 std/cs/_std/sys/thread/Lock.hx delete mode 100644 std/cs/_std/sys/thread/Mutex.hx delete mode 100644 std/cs/_std/sys/thread/Semaphore.hx delete mode 100644 std/cs/_std/sys/thread/Thread.hx delete mode 100644 std/cs/_std/sys/thread/Tls.hx delete mode 100644 std/cs/internal/BoxedPointer.hx delete mode 100644 std/cs/internal/FieldLookup.hx delete mode 100644 std/cs/internal/Function.hx delete mode 100644 std/cs/internal/HxObject.hx delete mode 100644 std/cs/internal/Null.hx delete mode 100644 std/cs/internal/Runtime.hx delete mode 100644 std/cs/internal/StringExt.hx delete mode 100644 std/cs/io/NativeInput.hx delete mode 100644 std/cs/io/NativeOutput.hx delete mode 100644 std/cs/types/Char16.hx delete mode 100644 std/cs/types/Int16.hx delete mode 100644 std/cs/types/Int64.hx delete mode 100644 std/cs/types/Int8.hx delete mode 100644 std/cs/types/UInt16.hx delete mode 100644 std/cs/types/UInt64.hx delete mode 100644 std/cs/types/UInt8.hx delete mode 100644 std/java/_std/EReg.hx delete mode 100644 std/java/_std/Reflect.hx delete mode 100644 std/java/_std/Std.hx delete mode 100644 std/java/_std/String.hx delete mode 100644 std/java/_std/StringBuf.hx delete mode 100644 std/java/_std/Type.hx delete mode 100644 std/java/_std/haxe/Rest.hx delete mode 100644 std/java/_std/haxe/ds/StringMap.hx delete mode 100644 std/java/_std/sys/thread/Lock.hx delete mode 100644 std/java/internal/FieldLookup.hx delete mode 100644 std/java/internal/Function.hx delete mode 100644 std/java/internal/HxObject.hx delete mode 100644 std/java/internal/IEquatable.hx delete mode 100644 std/java/internal/Runtime.hx delete mode 100644 std/java/internal/StringExt.hx delete mode 100644 tests/misc/cs/csTwoLibs/.gitignore delete mode 100644 tests/misc/cs/csTwoLibs/Lib1.hx delete mode 100644 tests/misc/cs/csTwoLibs/Main.hx delete mode 100644 tests/misc/cs/csTwoLibs/compile-1.hxml delete mode 100644 tests/misc/cs/csTwoLibs/compile-2.hxml delete mode 100644 tests/misc/cs/csTwoLibs/compile-3.hxml delete mode 100644 tests/misc/cs/csTwoLibs/compile-4.hxml delete mode 100644 tests/misc/cs/projects/Issue11350/Main.hx delete mode 100644 tests/misc/cs/projects/Issue11350/compile.hxml delete mode 100644 tests/misc/cs/projects/Issue3526/.gitignore delete mode 100644 tests/misc/cs/projects/Issue3526/IncompatibleCombinations.hx delete mode 100644 tests/misc/cs/projects/Issue3526/Main.hx delete mode 100644 tests/misc/cs/projects/Issue3526/compile-7.3.hxml delete mode 100644 tests/misc/cs/projects/Issue3526/compile.hxml delete mode 100644 tests/misc/cs/projects/Issue3526/incompatible-combinations-fail.hxml delete mode 100644 tests/misc/cs/projects/Issue3526/incompatible-combinations-fail.hxml.stderr delete mode 100644 tests/misc/cs/projects/Issue3703/Main.hx delete mode 100644 tests/misc/cs/projects/Issue3703/Test.hx delete mode 100644 tests/misc/cs/projects/Issue3703/compile.hxml delete mode 100644 tests/misc/cs/projects/Issue4002/Main.hx delete mode 100644 tests/misc/cs/projects/Issue4002/compile.hxml delete mode 100644 tests/misc/cs/projects/Issue4116/.gitignore delete mode 100644 tests/misc/cs/projects/Issue4116/base/A.hx delete mode 100644 tests/misc/cs/projects/Issue4116/compile.hxml delete mode 100644 tests/misc/cs/projects/Issue4598/Main.hx delete mode 100644 tests/misc/cs/projects/Issue4598/Run.hx delete mode 100644 tests/misc/cs/projects/Issue4598/compile.hxml delete mode 100644 tests/misc/cs/projects/Issue4623/Main.hx delete mode 100644 tests/misc/cs/projects/Issue4623/Run.hx delete mode 100644 tests/misc/cs/projects/Issue4623/compile.hxml delete mode 100644 tests/misc/cs/projects/Issue5434/Main.hx delete mode 100644 tests/misc/cs/projects/Issue5434/compile.hxml delete mode 100644 tests/misc/cs/projects/Issue5915/Test.hx delete mode 100644 tests/misc/cs/projects/Issue5915/compile.hxml delete mode 100644 tests/misc/cs/projects/Issue5953/Main.hx delete mode 100644 tests/misc/cs/projects/Issue5953/Reduced.hx delete mode 100644 tests/misc/cs/projects/Issue5953/compile.hxml delete mode 100644 tests/misc/cs/projects/Issue6635/Main.hx delete mode 100644 tests/misc/cs/projects/Issue6635/compile.hxml delete mode 100644 tests/misc/cs/projects/Issue6635/compile.hxml.stderr delete mode 100644 tests/misc/cs/projects/Issue7875/Main.hx delete mode 100644 tests/misc/cs/projects/Issue7875/compile.hxml delete mode 100644 tests/misc/cs/projects/Issue8347/.gitignore delete mode 100644 tests/misc/cs/projects/Issue8347/Main.hx delete mode 100644 tests/misc/cs/projects/Issue8347/compile-fail.hxml delete mode 100644 tests/misc/cs/projects/Issue8347/compile-fail.hxml.stderr delete mode 100644 tests/misc/cs/projects/Issue8347/compile.hxml delete mode 100644 tests/misc/cs/projects/Issue8347/src/fail/NotFirstType.hx delete mode 100644 tests/misc/cs/projects/Issue8347/src/pack/Main.hx delete mode 100644 tests/misc/cs/projects/Issue8361/Main.hx delete mode 100644 tests/misc/cs/projects/Issue8361/compile.hxml delete mode 100644 tests/misc/cs/projects/Issue8366/Main.hx delete mode 100644 tests/misc/cs/projects/Issue8366/compile.hxml delete mode 100644 tests/misc/cs/projects/Issue8487/Main1.hx delete mode 100644 tests/misc/cs/projects/Issue8487/Main2.hx delete mode 100644 tests/misc/cs/projects/Issue8487/compile-fail.hxml delete mode 100644 tests/misc/cs/projects/Issue8487/compile-fail.hxml.stderr delete mode 100644 tests/misc/cs/projects/Issue8487/compile.hxml delete mode 100644 tests/misc/cs/projects/Issue8589/Main.hx delete mode 100644 tests/misc/cs/projects/Issue8589/compile.hxml delete mode 100644 tests/misc/cs/projects/Issue8589/compile.hxml.stderr delete mode 100644 tests/misc/cs/projects/Issue8664/Main.hx delete mode 100644 tests/misc/cs/projects/Issue8664/compile.hxml delete mode 100644 tests/misc/cs/projects/Issue9799/Main.hx delete mode 100644 tests/misc/cs/projects/Issue9799/compile.hxml delete mode 100644 tests/misc/cs/run.hxml delete mode 100644 tests/misc/java/projects/Issue8322/Main.hx delete mode 100644 tests/misc/java/projects/Issue8322/compile.hxml create mode 100644 tests/misc/projects/Issue10844/user-defined-meta-json-pretty-fail.hxml.stderr rename tests/misc/projects/{Issue5002 => issue5002}/Macro.hx (100%) rename tests/misc/projects/{Issue5002 => issue5002}/Main.hx (100%) rename tests/misc/projects/{Issue5002 => issue5002}/Main2.hx (100%) rename tests/misc/projects/{Issue5002 => issue5002}/Main3.hx (100%) rename tests/misc/projects/{Issue5002 => issue5002}/Main4.hx (100%) rename tests/misc/projects/{Issue5002 => issue5002}/compile-fail.hxml (100%) rename tests/misc/projects/{Issue5002 => issue5002}/compile-fail.hxml.stderr (100%) rename tests/misc/projects/{Issue5002 => issue5002}/compile2-fail.hxml (100%) rename tests/misc/projects/{Issue5002 => issue5002}/compile2-fail.hxml.stderr (100%) rename tests/misc/projects/{Issue5002 => issue5002}/compile3-fail.hxml (100%) rename tests/misc/projects/{Issue5002 => issue5002}/compile3-fail.hxml.stderr (100%) rename tests/misc/projects/{Issue5002 => issue5002}/compile4-fail.hxml (100%) rename tests/misc/projects/{Issue5002 => issue5002}/compile4-fail.hxml.stderr (100%) delete mode 100644 tests/misc/weakmap/compile-cs.hxml delete mode 100644 tests/runci/targets/Cs.hx delete mode 100644 tests/runci/targets/Java.hx delete mode 100644 tests/sys/compile-cs.hxml delete mode 100644 tests/sys/compile-java.hxml delete mode 100644 tests/unit/compile-cs-unsafe.hxml delete mode 100644 tests/unit/compile-cs.hxml delete mode 100644 tests/unit/compile-exe-runner.hxml delete mode 100644 tests/unit/compile-java-runner.hxml delete mode 100644 tests/unit/compile-java.hxml delete mode 100644 tests/unit/native_cs/hxcs_build.txt delete mode 100644 tests/unit/native_cs/src/NoPackage.cs delete mode 100644 tests/unit/native_cs/src/haxe/test/AttrWithNullType.cs delete mode 100644 tests/unit/native_cs/src/haxe/test/Base.cs delete mode 100644 tests/unit/native_cs/src/haxe/test/Generic1.cs delete mode 100644 tests/unit/native_cs/src/haxe/test/GenericHelper.cs delete mode 100644 tests/unit/native_cs/src/haxe/test/MyClass.cs delete mode 100644 tests/unit/native_cs/src/haxe/test/OverloadInterface1.cs delete mode 100644 tests/unit/native_cs/src/haxe/test/OverloadInterface2.cs delete mode 100644 tests/unit/native_cs/src/haxe/test/StaticAndInstanceClash.cs delete mode 100644 tests/unit/native_cs/src/haxe/test/TEnum.cs delete mode 100644 tests/unit/native_cs/src/haxe/test/TEnumWithValue.cs delete mode 100644 tests/unit/src/unit/TestCSharp.hx delete mode 100644 tests/unit/src/unit/issues/Issue3383.hx delete mode 100644 tests/unit/src/unit/issues/Issue3558.hx delete mode 100644 tests/unit/src/unit/issues/Issue3771.hx delete mode 100644 tests/unit/src/unit/issues/Issue3946.hx delete mode 100644 tests/unit/src/unit/issues/Issue3949.hx delete mode 100644 tests/unit/src/unit/issues/Issue4045.hx delete mode 100644 tests/unit/src/unit/issues/Issue5110.hx.disabled delete mode 100644 tests/unit/src/unit/issues/Issue5399.hx delete mode 100644 tests/unit/src/unit/issues/Issue5747.hx delete mode 100644 tests/unit/src/unit/issues/Issue5751.hx delete mode 100644 tests/unit/src/unit/issues/Issue6039.hx delete mode 100644 tests/unit/src/unit/issues/Issue6784.hx delete mode 100644 tests/unit/src/unit/issues/Issue8978.hx delete mode 100644 tests/unit/src/unit/issues/Issue8979.hx delete mode 100644 tests/unit/src/unit/issues/Issue9738.hx delete mode 100644 tests/unit/src/unit/issues/Issue9946.hx diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index ce7248347b1..0f28548a6b6 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -371,7 +371,7 @@ jobs: fail-fast: false matrix: ocaml: ["4.08.1", "5.0.0"] - target: [macro, js, hl, cpp, 'java,jvm', cs, php, python, lua, flash, neko] + target: [macro, js, hl, cpp, jvm, php, python, lua, flash, neko] include: - target: hl APT_PACKAGES: cmake ninja-build libturbojpeg-dev @@ -519,7 +519,7 @@ jobs: haxe dox.hxml mkdir resources cp ../../src-json/* resources - cpp/Dox -i ../../xmldoc -ex microsoft -ex javax -ex cs.internal -theme $(haxelib libpath dox)/themes/default + cpp/Dox -i ../../xmldoc -ex microsoft -ex javax -theme $(haxelib libpath dox)/themes/default working-directory: ${{github.workspace}}/tests/docgen linux-arm64: @@ -690,7 +690,7 @@ jobs: fail-fast: false matrix: # TODO enable lua after https://github.com/HaxeFoundation/haxe/issues/10919 - target: [macro, js, hl, cpp, 'java,jvm', cs, php, python, flash, neko] + target: [macro, js, hl, cpp, jvm, php, python, flash, neko] steps: - uses: actions/checkout@main with: @@ -787,7 +787,7 @@ jobs: matrix: # TODO jvm: https://github.com/HaxeFoundation/haxe/issues/8601 # TODO enable lua after https://github.com/HaxeFoundation/haxe/issues/10919 - target: [macro, js, hl, cpp, java, cs, php, python, flash, neko] + target: [macro, js, hl, cpp, php, python, flash, neko] steps: - uses: actions/checkout@main with: @@ -881,7 +881,7 @@ jobs: strategy: fail-fast: false matrix: - target: [macro, js, hl, cpp, 'java,jvm', cs, php, python, flash, neko] + target: [macro, js, hl, cpp, jvm, php, python, flash, neko] include: - target: hl BREW_PACKAGES: ninja diff --git a/.vscode/schemas/meta.schema.json b/.vscode/schemas/meta.schema.json index b2dee2053c8..cc9e2ff4199 100644 --- a/.vscode/schemas/meta.schema.json +++ b/.vscode/schemas/meta.schema.json @@ -29,8 +29,7 @@ "flash", "php", "cpp", - "cs", - "java", + "jvm", "python", "hl", "eval" diff --git a/Earthfile b/Earthfile index dda473f6c60..00baadef0eb 100644 --- a/Earthfile +++ b/Earthfile @@ -221,7 +221,6 @@ xmldoc: RUN haxelib newrepo RUN haxelib git hxcpp https://github.com/HaxeFoundation/hxcpp RUN haxelib git hxjava https://github.com/HaxeFoundation/hxjava - RUN haxelib git hxcs https://github.com/HaxeFoundation/hxcs RUN haxe doc.hxml ARG COMMIT @@ -271,11 +270,6 @@ test-environment-php: DO +INSTALL_PACKAGES --PACKAGES="php-cli php-mbstring php-sqlite3" SAVE IMAGE --cache-hint -test-environment-cs: - FROM +test-environment - DO +INSTALL_PACKAGES --PACKAGES="mono-devel mono-mcs" - SAVE IMAGE --cache-hint - test-environment-hl: FROM +test-environment DO +INSTALL_PACKAGES --PACKAGES="cmake ninja-build libturbojpeg-dev libpng-dev zlib1g-dev libvorbis-dev libsqlite3-dev" @@ -361,12 +355,6 @@ test-jvm: ENV GITHUB_ACTIONS=$GITHUB_ACTIONS DO +RUN_CI --TEST=jvm -test-cs: - FROM +test-environment-cs - ARG GITHUB_ACTIONS - ENV GITHUB_ACTIONS=$GITHUB_ACTIONS - DO +RUN_CI --TEST=cs - test-php: FROM +test-environment-php ARG GITHUB_ACTIONS @@ -400,7 +388,6 @@ test-all: BUILD +test-python BUILD +test-java BUILD +test-jvm - BUILD +test-cs BUILD +test-cpp BUILD +test-lua BUILD +test-js diff --git a/Makefile b/Makefile index a369415b02b..634c698d403 100644 --- a/Makefile +++ b/Makefile @@ -162,7 +162,6 @@ xmldoc: $(CURDIR)/$(HAXELIB_OUTPUT) newrepo && \ $(CURDIR)/$(HAXELIB_OUTPUT) git hxcpp https://github.com/HaxeFoundation/hxcpp && \ $(CURDIR)/$(HAXELIB_OUTPUT) git hxjava https://github.com/HaxeFoundation/hxjava && \ - $(CURDIR)/$(HAXELIB_OUTPUT) git hxcs https://github.com/HaxeFoundation/hxcs && \ PATH="$(CURDIR):$(PATH)" $(CURDIR)/$(HAXE_OUTPUT) doc.hxml $(INSTALLER_TMP_DIR): diff --git a/README.md b/README.md index b7ee7589db0..2d17ef3d6a3 100644 --- a/README.md +++ b/README.md @@ -21,8 +21,6 @@ Haxe allows you to compile for the following targets: * JavaScript * C++ - * C# - * Java * JVM * Lua * PHP 7 diff --git a/extra/ImportAll.hx b/extra/ImportAll.hx index 390266bb8c7..a0818d1f3c7 100644 --- a/extra/ImportAll.hx +++ b/extra/ImportAll.hx @@ -25,7 +25,7 @@ class ImportAll { static function isSysTarget() { return Context.defined("neko") || Context.defined("php") || Context.defined("cpp") || - Context.defined("java") || Context.defined("python") || + Context.defined("jvm") || Context.defined("python") || Context.defined("lua") || Context.defined("hl") || Context.defined("eval"); } @@ -51,12 +51,8 @@ class ImportAll { if(!isSysTarget()) return; case "sys.thread": if ( !Context.defined("target.threaded") ) return; - case "java": - if( !Context.defined("java") ) return; - case "jvm": + case "java" | "jvm": if( !Context.defined("jvm") ) return; - case "cs": - if( !Context.defined("cs") ) return; case "python": if ( !Context.defined("python") ) return; case "hl": @@ -96,7 +92,6 @@ class ImportAll { case "haxe.remoting.SocketWrapper": if( !Context.defined("flash") ) continue; case "haxe.remoting.SyncSocketConnection": if( !(Context.defined("neko") || Context.defined("php") || Context.defined("cpp")) ) continue; case "neko.vm.Ui" | "sys.db.Sqlite" | "sys.db.Mysql" if ( Context.defined("interp") ): continue; - case "sys.db.Sqlite" | "sys.db.Mysql" | "cs.db.AdoNet" if ( Context.defined("cs") ): continue; case "haxe.atomic.AtomicBool" if(!Context.defined("target.atomics")): continue; case "haxe.atomic.AtomicInt" if(!Context.defined("target.atomics")): continue; case "haxe.atomic.AtomicObject" if(!Context.defined("target.atomics") || Context.defined("js") || Context.defined("cpp")): continue; diff --git a/extra/all.hxml b/extra/all.hxml index 9b8b7804523..f4446e51624 100644 --- a/extra/all.hxml +++ b/extra/all.hxml @@ -28,19 +28,10 @@ -xml cpp.xml -D HXCPP_MULTI_THREADED ---next --java all_java --xml java.xml - --next --jvm all_jvm -xml jvm.xml ---next --cs all_cs --D unsafe --xml cs.xml - --next -python all_python -xml python.xml diff --git a/extra/doc.hxml b/extra/doc.hxml index fa8b532121e..9a37c68e0f1 100644 --- a/extra/doc.hxml +++ b/extra/doc.hxml @@ -31,13 +31,8 @@ -D HXCPP_MULTI_THREADED --next --java all_java --xml doc/java.xml - ---next --cs all_cs --D unsafe --xml doc/cs.xml +--jvm all_jvm +-xml doc/jvm.xml --next -python all_py diff --git a/extra/github-actions/workflows/main.yml b/extra/github-actions/workflows/main.yml index 4b2825ccb37..767cf731fef 100644 --- a/extra/github-actions/workflows/main.yml +++ b/extra/github-actions/workflows/main.yml @@ -153,7 +153,7 @@ jobs: fail-fast: false matrix: ocaml: ["4.08.1", "5.0.0"] - target: [macro, js, hl, cpp, 'java,jvm', cs, php, python, lua, flash, neko] + target: [macro, js, hl, cpp, jvm, php, python, lua, flash, neko] include: - target: hl APT_PACKAGES: cmake ninja-build libturbojpeg-dev @@ -269,7 +269,7 @@ jobs: haxe dox.hxml mkdir resources cp ../../src-json/* resources - cpp/Dox -i ../../xmldoc -ex microsoft -ex javax -ex cs.internal -theme $(haxelib libpath dox)/themes/default + cpp/Dox -i ../../xmldoc -ex microsoft -ex javax -theme $(haxelib libpath dox)/themes/default working-directory: ${{github.workspace}}/tests/docgen linux-arm64: @@ -362,7 +362,7 @@ jobs: fail-fast: false matrix: # TODO enable lua after https://github.com/HaxeFoundation/haxe/issues/10919 - target: [macro, js, hl, cpp, 'java,jvm', cs, php, python, flash, neko] + target: [macro, js, hl, cpp, jvm, php, python, flash, neko] steps: - uses: actions/checkout@main with: @@ -389,7 +389,7 @@ jobs: matrix: # TODO jvm: https://github.com/HaxeFoundation/haxe/issues/8601 # TODO enable lua after https://github.com/HaxeFoundation/haxe/issues/10919 - target: [macro, js, hl, cpp, java, cs, php, python, flash, neko] + target: [macro, js, hl, cpp, php, python, flash, neko] steps: - uses: actions/checkout@main with: @@ -413,7 +413,7 @@ jobs: strategy: fail-fast: false matrix: - target: [macro, js, hl, cpp, 'java,jvm', cs, php, python, flash, neko] + target: [macro, js, hl, cpp, jvm, php, python, flash, neko] include: - target: hl BREW_PACKAGES: ninja diff --git a/extra/release-checklist.txt b/extra/release-checklist.txt index 50589471d88..7232112bc75 100644 --- a/extra/release-checklist.txt +++ b/extra/release-checklist.txt @@ -2,7 +2,7 @@ - Check that haxelib is working - Make sure to update the haxelib submodule -- Check that the run-time haxelibs are ready for release: hxcpp, hxjava, hxcs +- Check that the run-time haxelibs are ready for release: hxcpp, hxjava - Check that the NEKO_VERSION variable in the "Makefile" is set to the latest Neko version # Making the release diff --git a/libs/ilib/Makefile b/libs/ilib/Makefile deleted file mode 100644 index 11aaec9f268..00000000000 --- a/libs/ilib/Makefile +++ /dev/null @@ -1,26 +0,0 @@ -OCAMLOPT=ocamlopt -OCAMLC=ocamlc - -SRCS=peData.ml peReader.ml peWriter.ml ilMeta.mli ilData.mli ilMetaTools.ml ilMetaDebug.ml ilMetaReader.ml - -all: native bytecode - -native: ilib.cmxa -bytecode: ilib.cma - -ilib.cmxa: $(SRCS) - ocamlfind $(OCAMLOPT) -g -package extlib -safe-string -a -o ilib.cmxa $(SRCS) - -ilib.cma: $(SRCS) - ocamlfind $(OCAMLC) -g -package extlib -safe-string -a -o ilib.cma $(SRCS) - -dump: ilib.cmxa dump.ml peDataDebug.ml ilMetaDebug.ml - ocamlfind $(OCAMLOPT) -g -package extlib -safe-string -o dump ../extlib/extLib.cmxa ilib.cmxa peDataDebug.ml dump.ml - -clean: - rm -f ilib.cma ilib.cmxa ilib.lib ilib.a $(wildcard *.cmx) $(wildcard *.cmo) $(wildcard *.obj) $(wildcard *.o) $(wildcard *.cmi) dump - -.PHONY: all bytecode native clean - -Makefile: ; -$(SRCS): ; diff --git a/libs/ilib/dump.ml b/libs/ilib/dump.ml deleted file mode 100644 index 6a2d1f764b8..00000000000 --- a/libs/ilib/dump.ml +++ /dev/null @@ -1,38 +0,0 @@ -open PeDataDebug;; -open PeData;; -open PeReader;; -open Printf;; -open IlData;; -open IlMetaTools;; -open IlMetaDebug;; - -let main () = - if Array.length Sys.argv <> 2 then - print_endline "Usage: dump " - else begin - let r = create_r (open_in Sys.argv.(1)) PMap.empty in - let ctx = read r in - let pe = ctx.pe_header in - print_endline (coff_header_s pe.pe_coff_header); - print_endline (pe_header_s pe); - let idata = read_idata ctx in - List.iter (fun t -> print_endline (idata_table_s t)) idata; - let clr_header = read_clr_header ctx in - print_endline (clr_header_s (clr_header)); - let cache = IlMetaReader.create_cache () in - let meta = IlMetaReader.read_meta_tables ctx clr_header cache in - Hashtbl.iter (fun path _ -> - print_endline ("\n\nclass " ^ path_s path ^ ": "); - let cls = convert_class meta path in - List.iter (fun t -> printf "%d: <%s> " t.tnumber (if t.tname = None then "_" else Option.get t.tname)) cls.ctypes; - printf "\n\tis nested: %s - %s\n" (string_of_bool (cls.cenclosing <> None)) (if cls.cenclosing = None then "None" else path_s (Option.get cls.cenclosing)); - print_endline "\tfields:"; - List.iter (fun f -> printf "\t\t%s : %s\n" f.fname (ilsig_s f.fsig.ssig)) cls.cfields; - print_endline "\tmethods:"; - List.iter (fun m -> printf "\t\t%s : %s\n" m.mname (ilsig_s m.msig.ssig)) cls.cmethods; - print_endline "\tprops:"; - List.iter (fun p -> printf "\t\t%s : %s\n" p.pname (ilsig_s p.psig.ssig)) cls.cprops; - ) meta.il_typedefs - end;; - -main() diff --git a/libs/ilib/dune b/libs/ilib/dune deleted file mode 100644 index 52a6fd81fb1..00000000000 --- a/libs/ilib/dune +++ /dev/null @@ -1,15 +0,0 @@ -(include_subdirs no) - -(env - (_ - (flags (-w -3 -w -27)) - ) -) - -(library - (name ilib) - (modules_without_implementation ilData ilMeta) - (modules (:standard \ dump)) - (libraries extlib) - (wrapped false) -) diff --git a/libs/ilib/ilData.mli b/libs/ilib/ilData.mli deleted file mode 100644 index 377fa234dfe..00000000000 --- a/libs/ilib/ilData.mli +++ /dev/null @@ -1,115 +0,0 @@ -(* - * This file is part of ilLib - * Copyright (c)2004-2013 Haxe Foundation - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA - *) -open IlMeta;; - -type ilpath = string list * string list * string - -type ilsig = IlMeta.ilsig - -and ilsig_norm = - | LVoid | LBool | LChar - | LInt8 | LUInt8 | LInt16 - | LUInt16 | LInt32 | LUInt32 - | LInt64 | LUInt64 | LFloat32 - | LFloat64 | LString | LObject - | LPointer of ilsig_norm - | LTypedReference | LIntPtr | LUIntPtr - | LManagedPointer of ilsig_norm - | LValueType of ilpath * ilsig_norm list - | LClass of ilpath * ilsig_norm list - | LTypeParam of int - | LMethodTypeParam of int - | LVector of ilsig_norm - | LArray of ilsig_norm * (int option * int option) array - | LMethod of callconv list * ilsig_norm * (ilsig_norm list) - | LSentinel - -and ilsig_t = { - snorm : ilsig_norm; - ssig : ilsig; -} - -type ilversion = int * int (* minor + major *) - -type ilclass = { - cpath : ilpath; - cflags : type_def_flags; - csuper : ilsig_t option; - cfields : ilfield list; - cmethods : ilmethod list; - cimplements : ilsig_t list; - ctypes : type_param list; - cprops : ilprop list; - cevents : ilevent list; - (* cevents : *) - cenclosing : ilpath option; - cnested : ilpath list; - cattrs : meta_custom_attribute list; -} - -and type_param = { - tnumber : int; - tflags : generic_flags; - tname : string option; - tconstraints : ilsig_t list; -} - -and ilevent = { - ename : string; - eflags : event_flags; - eadd : (string * method_flags) option; - eremove : (string * method_flags) option; - eraise : (string * method_flags) option; - esig : ilsig_t; -} - -and ilfield = { - fname : string; - fflags : field_flags; - fsig : ilsig_t; - fconstant : constant option; -} - -and ilmethod = { - mname : string; - mflags : method_flags; - msig : ilsig_t; - margs : ilmethod_arg list; - mret : ilsig_t; - moverride : (ilpath * string) option; (* method_impl *) - (* refers to the signature of the declaring class *) - mtypes : type_param list; - msemantics : semantic_flags; -} - -and ilmethod_arg = string * param_flags * ilsig_t - -and ilprop = { - pname : string; - psig : ilsig_t; - pflags : property_flags; - pget : (string * method_flags) option; - pset : (string * method_flags) option; -} - -type ilctx = { - il_tables : (clr_meta DynArray.t) array; - il_relations : (meta_pointer, clr_meta) Hashtbl.t; - il_typedefs : (ilpath, meta_type_def) Hashtbl.t; -} diff --git a/libs/ilib/ilMeta.mli b/libs/ilib/ilMeta.mli deleted file mode 100644 index c0d74bdb8dc..00000000000 --- a/libs/ilib/ilMeta.mli +++ /dev/null @@ -1,1204 +0,0 @@ -(* - * This file is part of ilLib - * Copyright (c)2004-2013 Haxe Foundation - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA - *) - -open PeData;; - -(* useful types for describing CLI metadata *) -type guid = string - (* reference from the #GUID stream *) -type stringref = string - (* reference from the #Strings stream *) -type blobref = string - (* reference from the #Blob stream *) -type id = stringref - (* a stringref that references an identifier. *) - (* must begin with an alphabetic character, or the following characters: *) - (* #, $, @, _ *) - (* and continue with alphanumeric characters or one of the following: *) - (* ?, $, @, _, ` *) - -type ns = id list - -type rid = int - (* record id on a specified meta table *) - -type clr_meta_idx = - (* strongly-type each table index *) - | IModule | ITypeRef | ITypeDef | IFieldPtr - | IField | IMethodPtr | IMethod | IParamPtr - | IParam | IInterfaceImpl | IMemberRef | IConstant - | ICustomAttribute | IFieldMarshal | IDeclSecurity - | IClassLayout | IFieldLayout | IStandAloneSig - | IEventMap | IEventPtr | IEvent | IPropertyMap - | IPropertyPtr | IProperty | IMethodSemantics - | IMethodImpl | IModuleRef | ITypeSpec | IImplMap - | IFieldRVA | IENCLog | IENCMap | IAssembly - | IAssemblyProcessor | IAssemblyOS | IAssemblyRef - | IAssemblyRefProcessor | IAssemblyRefOS - | IFile | IExportedType | IManifestResource | INestedClass - | IGenericParam | IMethodSpec | IGenericParamConstraint - (* reserved metas *) - | IR0x2D | IR0x2E | IR0x2F - | IR0x30 | IR0x31 | IR0x32 | IR0x33 | IR0x34 | IR0x35 | IR0x36 | IR0x37 - | IR0x38 | IR0x39 | IR0x3A | IR0x3B | IR0x3C | IR0x3D | IR0x3E | IR0x3F - (* coded tokens *) - | ITypeDefOrRef | IHasConstant | IHasCustomAttribute - | IHasFieldMarshal | IHasDeclSecurity | IMemberRefParent - | IHasSemantics | IMethodDefOrRef | IMemberForwarded | IImplementation - | ICustomAttributeType | IResolutionScope | ITypeOrMethodDef - -type meta_pointer = clr_meta_idx * rid - (* generic reference to the meta table *) - -(* starting with all annotations of special coded types *) -type type_def_or_ref = clr_meta -and has_const = clr_meta -and has_custom_attribute = clr_meta -and has_field_marshal = clr_meta -and has_decl_security = clr_meta -and member_ref_parent = clr_meta -and has_semantics = clr_meta -and method_def_or_ref = clr_meta -and member_forwarded = clr_meta -and implementation = clr_meta -and custom_attribute_type = clr_meta -and resolution_scope = clr_meta -and type_or_method_def = clr_meta - -and clr_meta = - | Module of meta_module - (* the current module descriptor *) - | TypeRef of meta_type_ref - (* class reference descriptors *) - | TypeDef of meta_type_def - (* class or interface definition descriptors *) - | FieldPtr of meta_field_ptr - (* a class-to-fields lookup table - does not exist in optimized metadatas *) - | Field of meta_field - (* field definition descriptors *) - | MethodPtr of meta_method_ptr - (* a class-to-methods lookup table - does not exist in optimized metadatas *) - | Method of meta_method - (* method definition descriptors *) - | ParamPtr of meta_param_ptr - (* a method-to-parameters lookup table - does not exist in optimized metadatas *) - | Param of meta_param - (* parameter definition descriptors *) - | InterfaceImpl of meta_interface_impl - (* interface implementation descriptors *) - | MemberRef of meta_member_ref - (* member (field or method) reference descriptors *) - | Constant of meta_constant - (* constant value that map the default values stored in the #Blob stream to *) - (* respective fields, parameters and properties *) - | CustomAttribute of meta_custom_attribute - (* custom attribute descriptors *) - | FieldMarshal of meta_field_marshal - (* field or parameter marshaling descriptors for managed/unmanaged interop *) - | DeclSecurity of meta_decl_security - (* security descriptors *) - | ClassLayout of meta_class_layout - (* class layout descriptors that hold information about how the loader should lay out respective classes *) - | FieldLayout of meta_field_layout - (* field layout descriptors that specify the offset or oridnal of individual fields *) - | StandAloneSig of meta_stand_alone_sig - (* stand-alone signature descriptors. used in two capacities: *) - (* as composite signatures of local variables of methods *) - (* and as parameters of the call indirect (calli) IL instruction *) - | EventMap of meta_event_map - (* a class-to-events mapping table. exists also in optimized metadatas *) - | EventPtr of meta_event_ptr - (* an event map-to-events lookup table - does not exist in optimized metadata *) - | Event of meta_event - (* event descriptors *) - | PropertyMap of meta_property_map - (* a class-to-properties mapping table. exists also in optimized metadatas *) - | PropertyPtr of meta_property_ptr - (* a property map-to-properties lookup table - does not exist in optimized metadata *) - | Property of meta_property - (* property descriptors *) - | MethodSemantics of meta_method_semantics - (* method semantics descriptors that hold information about which method is associated *) - (* with a specific property or event and in what capacity *) - | MethodImpl of meta_method_impl - (* method implementation descriptors *) - | ModuleRef of meta_module_ref - (* module reference descriptors *) - | TypeSpec of meta_type_spec - (* Type specification descriptors *) - | ImplMap of meta_impl_map - (* implementation map descriptors used for platform invocation (P/Invoke) *) - | FieldRVA of meta_field_rva - (* field-to-data mapping descriptors *) - | ENCLog of meta_enc_log - (* edit-and-continue log descriptors that hold information about what changes *) - (* have been made to specific metadata items during in-memory editing *) - (* this table does not exist on optimized metadata *) - | ENCMap of meta_enc_map - (* edit-and-continue mapping descriptors. does not exist on optimized metadata *) - | Assembly of meta_assembly - (* the current assembly descriptor, which should appear only in the prime module metadata *) - | AssemblyProcessor of meta_assembly_processor | AssemblyOS of meta_assembly_os - (* unused *) - | AssemblyRef of meta_assembly_ref - (* assembly reference descriptors *) - | AssemblyRefProcessor of meta_assembly_ref_processor | AssemblyRefOS of meta_assembly_ref_os - (* unused *) - | File of meta_file - (* file descriptors that contain information about other files in the current assembly *) - | ExportedType of meta_exported_type - (* exported type descriptors that contain information about public classes *) - (* exported by the current assembly, which are declared in other modules of the assembly *) - (* only the prime module of the assembly should carry this table *) - | ManifestResource of meta_manifest_resource - (* managed resource descriptors *) - | NestedClass of meta_nested_class - (* nested class descriptors that provide mapping of nested classes to their respective enclosing classes *) - | GenericParam of meta_generic_param - (* type parameter descriptors for generic classes and methods *) - | MethodSpec of meta_method_spec - (* generic method instantiation descriptors *) - | GenericParamConstraint of meta_generic_param_constraint - (* descriptors of constraints specified for type parameters of generic classes and methods *) - | UnknownMeta of int - -(* all fields here need to be mutable, as they will first be initialized empty *) - -and meta_root = { - root_id : int; -} - -and meta_root_ptr = { - ptr_id : int; - ptr_to : meta_root; -} - -and meta_module = { - mutable md_id : int; - mutable md_generation : int; - mutable md_name : id; - mutable md_vid : guid; - mutable md_encid : guid; - mutable md_encbase_id : guid; -} - -and meta_type_ref = { - mutable tr_id : int; - mutable tr_resolution_scope : resolution_scope; - mutable tr_name : id; - mutable tr_namespace : ns; -} - -and meta_type_def = { - mutable td_id : int; - mutable td_flags : type_def_flags; - mutable td_name : id; - mutable td_namespace : ns; - mutable td_extends : type_def_or_ref option; - mutable td_field_list : meta_field list; - mutable td_method_list : meta_method list; - - (* extra field *) - mutable td_extra_enclosing : meta_type_def option; -} - -and meta_field_ptr = { - mutable fp_id : int; - mutable fp_field : meta_field; -} - -and meta_field = { - mutable f_id : int; - mutable f_flags : field_flags; - mutable f_name : id; - mutable f_signature : ilsig; -} - -and meta_method_ptr = { - mutable mp_id : int; - mutable mp_method : meta_method; -} - -and meta_method = { - mutable m_id : int; - mutable m_rva : rva; - mutable m_flags : method_flags; - mutable m_name : id; - mutable m_signature : ilsig; - mutable m_param_list : meta_param list; (* rid: Param *) - - (* extra field *) - mutable m_declaring : meta_type_def option; -} - -and meta_param_ptr = { - mutable pp_id : int; - mutable pp_param : meta_param; -} - -and meta_param = { - mutable p_id : int; - mutable p_flags : param_flags; - mutable p_sequence : int; - (* 0 means return value *) - mutable p_name : id; -} - -and meta_interface_impl = { - mutable ii_id : int; - mutable ii_class : meta_type_def; (* TypeDef rid *) - mutable ii_interface : type_def_or_ref; -} - -and meta_member_ref = { - mutable memr_id : int; - mutable memr_class : member_ref_parent; - mutable memr_name : id; - mutable memr_signature : ilsig; -} - -and meta_constant = { - mutable c_id : int; - mutable c_type : constant_type; - mutable c_parent : has_const; - mutable c_value : constant; -} - -and named_attribute = bool * string * instance (* is_property * name * instance *) - -and meta_custom_attribute = { - mutable ca_id : int; - mutable ca_parent : has_custom_attribute; - mutable ca_type : custom_attribute_type; - mutable ca_value : (instance list * named_attribute list) option; - (* can be 0 *) -} - -and meta_field_marshal = { - mutable fm_id : int; - mutable fm_parent : has_field_marshal; - mutable fm_native_type : nativesig; -} - -and meta_decl_security = { - mutable ds_id : int; - mutable ds_action : action_security; - mutable ds_parent : has_decl_security; - mutable ds_permission_set : blobref; - (* an xml with the permission set *) -} - -and meta_class_layout = { - mutable cl_id : int; - mutable cl_packing_size : int; - (* power of two; from 1 through 128 *) - mutable cl_class_size : int; - mutable cl_parent : meta_type_def; (* TypeDef rid *) -} - -and meta_field_layout = { - mutable fl_id : int; - mutable fl_offset : int; - (* offset in bytes or ordinal *) - mutable fl_field : meta_field; (* Field rid *) -} - -and meta_stand_alone_sig = { - mutable sa_id : int; - mutable sa_signature : ilsig; -} - -and meta_event_map = { - mutable em_id : int; - mutable em_parent : meta_type_def; (* TypeDef rid *) - mutable em_event_list : meta_event list; (* Event rid *) -} - -and meta_event_ptr = { - mutable ep_id : int; - mutable ep_event : meta_event; (* Event rid *) -} - -and meta_event = { - mutable e_id : int; - mutable e_flags : event_flags; - mutable e_name : stringref; - mutable e_event_type : type_def_or_ref; -} - -and meta_property_map = { - mutable pm_id : int; - mutable pm_parent : meta_type_def; (* TypeDef rid *) - mutable pm_property_list : meta_property list; (* Property rid *) -} - -and meta_property_ptr = { - mutable prp_id : int; - mutable prp_property : meta_property; (* Property rid *) -} - -and meta_property = { - mutable prop_id : int; - mutable prop_flags : property_flags; - mutable prop_name : stringref; - mutable prop_type : ilsig; -} - -and meta_method_semantics = { - mutable ms_id : int; - mutable ms_semantic : semantic_flags; - mutable ms_method : meta_method; (* Method rid *) - mutable ms_association : has_semantics; -} - -and meta_method_impl = { - mutable mi_id : int; - mutable mi_class : meta_type_def; (* TypeDef rid *) - mutable mi_method_body : method_def_or_ref; - (* overriding method *) - mutable mi_method_declaration : method_def_or_ref; - (* overridden method *) -} - -and meta_module_ref = { - mutable modr_id : int; - mutable modr_name : stringref; -} - -and meta_type_spec = { - mutable ts_id : int; - mutable ts_signature : ilsig; -} - -(* reserved ? *) -and meta_enc_log = { - mutable el_id : int; - mutable el_token : to_det; - mutable el_func_code : to_det; -} - -and meta_impl_map = { - mutable im_id : int; - mutable im_flags : impl_flags; (* mapping_flags *) - mutable im_forwarded : member_forwarded; (* method only *) - mutable im_import_name : stringref; - mutable im_import_scope : meta_module_ref; (* ModuleRef rid *) -} - -(* reserved ? *) -and meta_enc_map = { - mutable encm_id : int; - mutable encm_token : to_det; -} - -and meta_field_rva = { - mutable fr_id : int; - mutable fr_rva : rva; - mutable fr_field : meta_field; (* Field rid *) -} - -and meta_assembly = { - mutable a_id : int; - mutable a_hash_algo : hash_algo; - mutable a_major : int; - mutable a_minor : int; - mutable a_build : int; - mutable a_rev : int; - mutable a_flags : assembly_flags; (* assembly_flags *) - mutable a_public_key : blobref; - mutable a_name : stringref; - mutable a_locale : stringref; -} - -(* unused *) -and meta_assembly_processor = { - mutable ap_id : int; - mutable ap_processor : to_det; -} - -(* unused *) -and meta_assembly_os = { - mutable aos_id : int; - mutable aos_platform_id : to_det; - mutable aos_major_version : to_det; - mutable aos_minor_version : to_det; -} - -and meta_assembly_ref = { - mutable ar_id : int; - mutable ar_major : int; - mutable ar_minor : int; - mutable ar_build : int; - mutable ar_rev : int; - mutable ar_flags : assembly_flags; - mutable ar_public_key : blobref; - mutable ar_name : stringref; (* no path, no extension *) - mutable ar_locale : stringref; - mutable ar_hash_value : blobref; -} - -(* unused *) -and meta_assembly_ref_processor = { - mutable arp_id : int; - mutable arp_processor : to_det; - mutable arp_assembly_ref : meta_assembly_ref; (* AssemblyRef rid *) -} - -(* unused *) -and meta_assembly_ref_os = { - mutable aros_id : int; - mutable aros_platform_id : to_det; - mutable aros_major : int; - mutable aros_minor : int; - mutable aros_assembly_ref : meta_assembly_ref; (* AssemblyRef rid *) -} - -and meta_file = { - mutable file_id : int; - mutable file_flags : file_flag; (* file_flags *) - mutable file_name : stringref; (* no path; only file name *) - mutable file_hash_value : blobref; -} - -and meta_exported_type = { - mutable et_id : int; - mutable et_flags : type_def_flags; - mutable et_type_def_id : int; - (* TypeDef token in another module *) - mutable et_type_name : stringref; - mutable et_type_namespace : ns; - mutable et_implementation : implementation; -} - -and meta_manifest_resource = { - mutable mr_id : int; - mutable mr_offset : int; - mutable mr_flags : manifest_resource_flag; (* manifest_resource_flags *) - mutable mr_name : stringref; - mutable mr_implementation : implementation option; -} - -and meta_nested_class = { - mutable nc_id : int; - mutable nc_nested : meta_type_def; (* TypeDef rid *) - mutable nc_enclosing : meta_type_def; (* TypeDef rid *) -} - -and meta_generic_param = { - mutable gp_id : int; - mutable gp_number : int; (* ordinal *) - mutable gp_flags : generic_flags; - mutable gp_owner : type_or_method_def; - (* generic type or method *) - mutable gp_name : stringref option; -} - -and meta_method_spec = { - mutable mspec_id : int; - mutable mspec_method : method_def_or_ref; - (* instantiated method *) - mutable mspec_instantiation : ilsig; - (* instantiated signature *) -} - -and meta_generic_param_constraint = { - mutable gc_id : int; - mutable gc_owner : meta_generic_param; (* GenericParam rid *) - (* constrained parameter *) - mutable gc_constraint : type_def_or_ref; - (* type the parameter must extend or implement *) -} - -and to_det = int - -and not_implemented = int - -and constant = - | IBool of bool - | IChar of int - | IByte of int - | IShort of int - | IInt of int32 - | IInt64 of int64 - | IFloat32 of float - | IFloat64 of float - | IString of string - | INull - -and instance = - | InstConstant of constant - | InstBoxed of instance - | InstType of string - | InstArray of instance list - | InstEnum of int - -and constant_type = - | CBool (* 0x2 *) - | CChar (* 0x3 *) - | CInt8 (* 0x4 *) - | CUInt8 (* 0x5 *) - | CInt16 (* 0x6 *) - | CUInt16 (* 0x7 *) - | CInt32 (* 0x8 *) - | CUInt32 (* 0x9 *) - | CInt64 (* 0xA *) - | CUInt64 (* 0xB *) - | CFloat32 (* 0xC *) - | CFloat64 (* 0xD *) - | CString (* 0xE *) - | CNullRef (* 0x12 *) - (* null object reference - the value of the constant *) - (* of this type must be a 4-byte integer containing 0 *) - -and type_def_vis = - (* visibility flags - mask 0x7 *) - | VPrivate (* 0x0 *) - (* type is not visible outside the assembly. default *) - | VPublic (* 0x1 *) - (* type visible outside the assembly *) - | VNestedPublic (* 0x2 *) - (* the nested type has public visibility *) - | VNestedPrivate (* 0x3 *) - (* nested type has private visibility - it's not visible outside the enclosing class *) - | VNestedFamily (* 0x4 *) - (* nested type has family visibility - it's visible to descendants of the enclosing class only *) - | VNestedAssembly (* 0x5 *) - (* nested type visible within the assembly only *) - | VNestedFamAndAssem (* 0x6 *) - (* nested type is visible to the descendants of the enclosing class residing in the same assembly *) - | VNestedFamOrAssem (* 0x7 *) - (* nested type is visible to the descendants of the enclosing class either within *) - (* or outside the assembly and to every type within the assembly *) - -and type_def_layout = - (* layout flags - mask 0x18 *) - | LAuto (* 0x0 *) - (* type fields are laid out automatically *) - | LSequential (* 0x8 *) - (* loader must preserve the order of the instance fields *) - | LExplicit (* 0x10 *) - (* type layout is specified explicitly *) - -and type_def_semantics = - (* semantics flags - mask 0x5A0 *) - | SInterface (* 0x20 *) - (* type is an interface. If specified, the default parent is set to nil *) - | SAbstract (* 0x80 *) - | SSealed (* 0x100 *) - | SSpecialName (* 0x400 *) - (* type has a special name. how special depends on the name itself *) - (* e.g. .ctor or .cctor *) - -and type_def_impl = - (* type implementation flags - mask 0x103000 *) - | IImport (* 0x1000 *) - (* the type is imported from a COM type library *) - | ISerializable (* 0x2000 *) - (* the type can be serialized into sequential data *) - | IBeforeFieldInit (* 0x00100000 *) - (* the type can be initialized any time before the first access *) - (* to a static field. *) - -and type_def_string = - (* string formatting flags - mask 0x00030000 *) - | SAnsi (* 0x0 *) - (* managed strings are marshaled to and from ANSI strings *) - | SUnicode (* 0x00010000 *) - (* managed strings are marshaled to and from UTF-16 *) - | SAutoChar (* 0x00020000 *) - (* marshaling is defined by the underlying platform *) - -and type_def_flags = { - tdf_vis : type_def_vis; - tdf_layout : type_def_layout; - tdf_semantics : type_def_semantics list; - tdf_impl : type_def_impl list; - tdf_string : type_def_string; -} - -and field_access = - (* access flags - mask 0x07 *) - | FAPrivateScope (* 0x0 *) - (* default - exempt from the requirement of having a unique triad of owner, name and signature *) - (* so it must always be referenced by a FieldDef token and never by a MemberRef *) - (* privatescope fields are accessible from anywhere within the current module *) - | FAPrivate (* 0x1 *) - (* field is accessible from its owner and from classes nested in the field's owner. *) - (* global private fields are accessible from anywhere within current module *) - | FAFamAndAssem (* 0x2 *) - (* accessible from types belonging to the owner's family defined in the current assembly *) - (* family means the type itself and all its descendants *) - | FAAssembly (* 0x3 *) - (* accessible from types defined in the current assembly *) - | FAFamily (* 0x4 *) - (* accessible from the owner's family - defined in this or any other assembly *) - | FAFamOrAssem (* 0x5 *) - (* accessible from the owner's family and from all types defined in the current assembly *) - | FAPublic (* 0x6 *) - (* field is accessible from any type *) - -and field_contract = - (* contract flags - mask 0x02F0 *) - | CStatic (* 0x10 *) - (* static field. global fields must be static *) - | CInitOnly (* 0x20 *) - (* field can be initialized only and cannot be written to later. *) - (* Initialization takes place in an instance constructor (.ctor) for instance fields *) - (* and in a class constructor (.cctor) for static fields. *) - (* this flag is not enforced by the CLR *) - | CLiteral (* 0x40 *) - (* field is a compile-time constant. the loader does not lay out this field *) - (* and does not create an internal handle for it *) - (* it cannot be directly addressed from IL and can only be used as a Reflection reference *) - | CNotSerialized (* 0x80 *) - (* field is not serialized when the owner is remoted *) - | CSpecialName (* 0x200 *) - (* the field is special in some way, as defined by its name *) - (* example is the field value__ of an enumeration type *) - -and field_reserved = - (* reserved flags - cannot be set explicitly. mask 0x9500 *) - | RSpecialName (* 0x400 *) - (* has a special name that is reserved for internal use of the CLR *) - (* two field names are reserved: value_, for instance fields in enumerations *) - (* and _Deleted* for fields marked for deletion but not actually removed from metadata *) - | RMarshal (* 0x1000 *) - (* The field has an associated FieldMarshal record specifying how the field must be *) - (* marshaled when consumed by unmanaged code. *) - | RConstant (* 0x8000 *) - (* field has an associated Constant record *) - | RFieldRVA (* 0x0100 *) - (* field is mapped to data and has an associated FieldRVA record *) - -and field_flags = { - ff_access : field_access; - ff_contract : field_contract list; - ff_reserved : field_reserved list; -} - -and method_contract = - (* contract flags - mask 0xF0 *) - | CMStatic (* 0x10 *) - | CMFinal (* 0x20 *) - (* must be paired with the virtual flag - otherwise it is meaningless *) - | CMVirtual (* 0x40 *) - | CMHideBySig (* 0x80 *) - (* the method hides all methods of the parent classes that have a matching *) - (* signature and name (as opposed to having a matching name only). ignored by the CLR *) - -and method_vtable = - (* vtable flags - mask 0x300 *) - | VNewSlot (* 0x100 *) - (* a new vtable slot is created, so it doesn't override the old implementation *) - | VStrict (* 0x200 *) - (* virtual method can be overridden only if it is accessible from the overriding class *) - -and method_impl = - (* implementation flags - mask 0x2C08 *) - | IAbstract (* 0x0400 *) - | ISpecialName (* 0x0800 *) - | IPInvokeImpl (* 0x2000 *) - (* the method has an unmanaged implementation and is called through the platform *) - (* invocation mechanism. the rva field must be 0, since the method is implemented externally *) - | IUnmanagedExp (* 0x0008 *) - (* the managed method is exposed as an unmanaged export. not used by the CLR currently *) - -and method_reserved = - (* reserved flags - cannot be set explicitly. mask 0xD000 *) - | RTSpecialName (* 0x1000 *) - (* has a special name: .ctor, .cctor, _VtblGap* and _Deleted* *) - | RHasSecurity (* 0x4000 *) - (* either has an associated DeclSecurity metadata or the custom attribte *) - (* System.Security.SuppressUnmanagedCodeSecurityAttribute *) - | RReqSecObj (* 0x8000 *) - (* this method calls another method containing security code, so it requires *) - (* an additional stack slot for a security object. *) - -and method_code_type = - (* code type - mask 0x3 *) - | CCil (* 0x0 *) - | CNative (* 0x1 *) - (* implemented in native platform-specific code *) - | COptIl (* 0x2 *) - (* optimized il - not supported; must not be set *) - | CRuntime (* 0x3 *) - (* automatically generated by the runtime itself (intrinsic) *) - -and method_code_mngmt = - (* code management - mask 0x4 *) - | MManaged (* 0x0 *) - | MUnmanaged (* 0x4 *) - (* must be paired with the native flag *) - -and method_interop = - (* method implementation and interop - mask 0x10D8 *) - | OForwardRef (* 0x10 *) - (* managed object fiels and edit-and-continue scenarios only *) - | OPreserveSig (* 0x80 *) - (* method signature must not be mangled during interop with classic COM code *) - | OInternalCall (* 0x1000 *) - (* reserved for internal use. if set, RVA must be 0 *) - | OSynchronized (* 0x20 *) - (* automatically insert code to take a lock on entry to the method and release it *) - (* on exit from the method. Value types cannot have this flag set *) - | ONoInlining (* 0x08 *) - (* the runtime is not allowed to inline the method *) - -and method_flags = { - mf_access : field_access; - mf_contract : method_contract list; - mf_vtable : method_vtable list; - mf_impl : method_impl list; - mf_reserved : method_reserved list; - mf_code_type : method_code_type; - mf_code_mngmt : method_code_mngmt; - mf_interop : method_interop list; -} - -and param_io = - (* input/output flags - mask 0x13 *) - | PIn (* 0x1 *) - | POut (* 0x2 *) - | POpt (* 0x10 *) - -and param_reserved = - (* reserved flags - mask 0xF000 *) - | PHasConstant (* 0x1000 *) - (* the parameter has an associated Constant record *) - | PMarshal (* 0x2000 *) - (* the parameter has an associated FieldMarshal record specifying how the parameter *) - (* must be marshaled when consumed by unmanaged code *) - -and param_flags = { - pf_io : param_io list; - pf_reserved : param_reserved list; -} - -and event_flag = - | ESpecialName (* 0x0200 *) - (* event is special *) - | ERTSpecialName (* 0x0400 *) - (* CLI provides special behavior, depending on the name of the event *) - -and event_flags = event_flag list - -and property_flag = - | PSpecialName (* 0x0200 *) - (* property is special *) - | PRTSpecialName (* 0x0400 *) - (* runtime (intrinsic) should check name encoding *) - | PHasDefault (* 0x1000 *) - (* property has default *) - | PUnused (* 0xE9FF *) - (* reserved *) - -and property_flags = property_flag list - -and semantic_flag = - | SSetter (* 0x0001 *) - (* setter for property *) - | SGetter (* 0x0002 *) - (* getter for property *) - | SOther (* 0x0004 *) - (* other method for property or event *) - | SAddOn (* 0x0008 *) - (* addon method for event - refers to the required add_ method for events *) - | SRemoveOn (* 0x0010 *) - (* removeon method for event - refers to the required remove_ method for events *) - | SFire (* 0x0020 *) - (* fire method for event. this refers to the optional raise_ method for events *) - -and semantic_flags = semantic_flag list - -and action_security = - | SecNull - | SecRequest (* 0x1 *) - | SecDemand (* 0x2 *) - | SecAssert (* 0x3 *) - | SecDeny (* 0x4 *) - | SecPermitOnly (* 0x5 *) - | SecLinkCheck (* 0x6 *) - | SecInheritCheck (* 0x7 *) - | SecReqMin (* 0x8 *) - | SecReqOpt (* 0x9 *) - | SecReqRefuse (* 0xA *) - | SecPreJitGrant (* 0xB *) - | SecPreJitDeny (* 0xC *) - | SecNonCasDemand (* 0xD *) - | SecNonCasLinkDemand (* 0xE *) - | SecNonCasInheritance (* 0xF *) - -and impl_charset = - | IDefault (* 0x0 *) - | IAnsi (* 0x2 *) - (* method parameters of type string must be marshaled as ANSI zero-terminated *) - (* strings unless explicitly specified otherwise *) - | IUnicode (* 0x4 *) - (* method parameters of type string must be marshaled as Unicode strings *) - | IAutoChar (* 0x6 *) - (* method parameters of type string must be marshaled as ANSI or Unicode strings *) - (* depending on the platform *) - -and impl_callconv = - | IDefaultCall (* 0x0 *) - | IWinApi (* 0x100 *) - (* the native method uses the calling convention standard for the underlying platform *) - | ICDecl (* 0x200 *) - (* the native method uses the C/C++ style calling convention *) - | IStdCall (* 0x300 *) - (* native method uses the standard Win32 API calling convention *) - | IThisCall (* 0x400 *) - (* native method uses the C++ member method (non-vararg) calling convention *) - | IFastCall (* 0x500 *) - -and impl_flag = - | INoMangle (* 0x1 *) - (* exported method's name must be matched literally *) - | IBestFit (* 0x10 *) - (* allow "best fit" guessing when converting the strings *) - | IBestFitOff (* 0x20 *) - (* disallow "best fit" guessing *) - | ILastErr (* 0x40 *) - (* the native method supports the last error querying by the Win32 API GetLastError *) - | ICharMapError (* 0x1000 *) - (* throw an exception when an unmappable character is encountered in a string *) - | ICharMapErrorOff (* 0x2000 *) - (* don't throw an exception when an unmappable character is encountered *) - -and impl_flags = { - if_charset : impl_charset; - if_callconv : impl_callconv; - if_flags : impl_flag list; -} - -and hash_algo = - | HNone (* 0x0 *) - | HReserved (* 0x8003 *) - (* MD5 ? *) - | HSha1 (* 0x8004 *) - (* SHA1 *) - -and assembly_flag = - | APublicKey (* 0x1 *) - (* assembly reference holds the full (unhashed) public key *) - | ARetargetable (* 0x100 *) - (* implementation of this assembly used at runtime is not expected to match *) - (* the version seen at compile-time *) - | ADisableJitCompileOptimizer (* 0x4000 *) - (* Reserved *) - | AEnableJitCompileTracking (* 0x8000 *) - (* Reserved *) - -and assembly_flags = assembly_flag list - -and file_flag = - | ContainsMetadata (* 0x0 *) - | ContainsNoMetadata (* 0x1 *) - -and manifest_resource_flag = - (* mask 0x7 *) - | RNone (* 0x0 *) - | RPublic (* 0x1 *) - | RPrivate (* 0x2 *) - -and generic_variance = - (* mask 0x3 *) - | VNone (* 0x0 *) - | VCovariant (* 0x1 *) - | VContravariant (* 0x2 *) - -and generic_constraint = - (* mask 0x1C *) - | CInstanceType (* 0x4 *) - (* generic parameter has the special class constraint *) - | CValueType (* 0x8 *) - (* generic parameter has the special valuetype constraint *) - | CDefaultCtor (* 0x10 *) - (* has the special .ctor constraint *) - -and generic_flags = { - gf_variance : generic_variance; - gf_constraint : generic_constraint list; -} - -and ilsig = - (* primitive types *) - | SVoid (* 0x1 *) - | SBool (* 0x2 *) - | SChar (* 0x3 *) - | SInt8 (* 0x4 *) - | SUInt8 (* 0x5 *) - | SInt16 (* 0x6 *) - | SUInt16 (* 0x7 *) - | SInt32 (* 0x8 *) - | SUInt32 (* 0x9 *) - | SInt64 (* 0xA *) - | SUInt64 (* 0xB *) - | SFloat32 (* 0xC *) - | SFloat64 (* 0xD *) - | SString (* 0xE *) - | SPointer of ilsig (* 0xF *) - (* unmanaged pointer to type ( * ) *) - | SManagedPointer of ilsig (* 0x10 *) - (* managed pointer to type ( & ) *) - | SValueType of type_def_or_ref (* 0x11 *) - (* a value type modifier, followed by TypeDef or TypeRef token *) - | SClass of type_def_or_ref (* 0x12 *) - (* a class type modifier, followed by TypeDef or TypeRef token *) - | STypeParam of int (* 0x13 *) - (* generic parameter in a generic type definition. represented by a number *) - | SArray of ilsig * (int option * int option) array (* 0x14 *) - (* ilsig * ( bound * size ) *) - (* a multi-dimensional array type modifier *) - (* encoded like: *) - (* SArray ... - ... *) - (* is the number of dimensions (K>0) *) - (* num of specified sizes for dimensions (N <= K) *) - (* num of lower bounds (M <= K) *) - (* all int values are compressed *) - | SGenericInst of ilsig * (ilsig list) (* 0x15 *) - (* A generic type instantiation. encoded like: *) - (* SGenericInst ... *) - | STypedReference (* 0x16 *) - (* typed reference, carrying both a reference to a type *) - (* and information identifying the referenced type *) - | SIntPtr (* 0x18 *) - (* pointer-sized managed integer *) - | SUIntPtr (* 0x19 *) - (* pointer-size managed unsigned integer *) - (* | SNativeFloat (* 0x1A *) *) - (* refer to http://stackoverflow.com/questions/13961205/native-float-type-usage-in-clr *) - | SFunPtr of callconv list * ilsig * (ilsig list) (* 0x1B *) - (* a pointer to a function, followed by full method signature *) - | SObject (* 0x1C *) - (* System.Object *) - | SVector of ilsig (* 0x1D *) - (* followed by the encoding of the underlying type *) - | SMethodTypeParam of int (* 0x1E *) - (* generic parameter in a generic method definition *) - | SReqModifier of type_def_or_ref * ilsig (* 0x1F *) - (* modreq: required custom modifier : indicate that the item to which they are attached *) - (* must be treated in a special way *) - | SOptModifier of type_def_or_ref * ilsig (* 0x20 *) - (* modopt: optional custom modifier *) - | SSentinel (* 0x41 *) - (* ... - signifies the beginning of optional arguments supplied for a vararg method call *) - (* This can only appear at call site, since varargs optional parameters are not specified *) - (* when a method is declared *) - | SPinned of ilsig (* 0x45 *) - (* pinned reference: it's only applicable to local variables only *) - (* special undocumented (yay) *) - | SType (* 0x50 *) - | SBoxed (* 0x51 *) - | SEnum of string (* 0x55 *) - -and callconv = - | CallDefault (* 0x0 *) - | CallCDecl (* 0x1 *) - | CallStdCall (* 0x2 *) - | CallThisCall (* 0x3 *) - | CallFastCall (* 0x4 *) - | CallVararg (* 0x5 *) - | CallField (* 0x6 *) - (* field call *) - | CallLocal (* 0x7 *) - (* local variable call *) - | CallProp (* 0x8 *) - (* property call *) - | CallUnmanaged (* 0x9 *) - (* unmanaged calling convention. not used *) - | CallGenericInst (* 0xA *) - (* generic instantiation - MethodSpec *) - | CallGeneric of int (* 0x10 *) - (* also contains the number of generic arguments *) - | CallHasThis (* 0x20 *) - (* instance method that has an instance pointer (this) *) - (* as an implicit first argument - ilasm 'instance' *) - | CallExplicitThis (* 0x40 *) - (* the first explicitly specified parameter is the instance pointer *) - (* ilasm 'explicit' *) - -and nativesig = - | NVoid (* 0x01 *) - (* obsolete *) - | NBool (* 0x02 *) - | NInt8 (* 0x03 *) - | NUInt8 (* 0x4 *) - | NInt16 (* 0x5 *) - | NUInt16 (* 0x6 *) - | NInt32 (* 0x7 *) - | NUInt32 (* 0x8 *) - | NInt64 (* 0x9 *) - | NUInt64 (* 0xA *) - | NFloat32 (* 0xB *) - | NFloat64 (* 0xC *) - | NSysChar (* 0xD *) - (* obsolete *) - | NVariant (* 0xE *) - (* obsolete *) - | NCurrency (* 0xF *) - | NPointer (* 0x10 *) - (* obsolete - use NativeInt *) - | NDecimal (* 0x11 *) - (* obsolete *) - | NDate (* 0x12 *) - (* obsolete *) - | NBStr (* 0x13 *) - (* unicode VB-style: used in COM operations *) - | NLPStr (* 0x14 *) - (* pointer to a zero-terminated ANSI string *) - | NLPWStr (* 0x15 *) - (* pointer to a zero-terminated Unicode string *) - | NLPTStr (* 0x16 *) - (* pointer to a zero-terminated ANSI or Unicode string - depends on platform *) - | NFixedString of int (* 0x17 *) - (* fixed-size system string of size bytes; applicable to field marshalling only *) - | NObjectRef (* 0x18 *) - (* obsolete *) - | NUnknown (* 0x19 *) - (* IUnknown interface pointer *) - | NDispatch (* 0x1A *) - (* IDispatch interface pointer *) - | NStruct (* 0x1B *) - (* C-style structure, for marshaling the formatted managed types *) - | NInterface (* 0x1C *) - (* interface pointer *) - | NSafeArray of variantsig (* 0x1D *) - (* safe array of type *) - | NFixedArray of int * variantsig (* 0x1E *) - (* fixed-size array, of size bytes *) - | NIntPointer (* 0x1F *) - (* signed pointer-size integer *) - | NUIntPointer (* 0x20 *) - (* unsigned pointer-sized integer *) - | NNestedStruct (* 0x21 *) - (* obsolete *) - | NByValStr (* 0x22 *) - (* VB-style string in a fixed-length buffer *) - | NAnsiBStr (* 0x23 *) - (* ansi bstr - ANSI VB-style string *) - | NTBStr (* 0x24 *) - (* tbstr - bstr or ansi bstr, depending on the platform *) - | NVariantBool (* 0x25 *) - (* variant bool - 2-byte Boolean: true = -1; false = 0 *) - | NFunctionPtr (* 0x26 *) - | NAsAny (* 0x28 *) - (* as any - object: type defined at run time (?) *) - | NArray of nativesig * int * int * int (* 0x2A *) - (* fixed-size array of a native type *) - (* if size is empty, the size of the native array is derived from the size *) - (* of the managed type being marshaled *) - | NLPStruct (* 0x2B *) - (* pointer to a c-style structure *) - | NCustomMarshaler of string * string (* 0x2C *) - (* custom (, ) *) - | NError (* 0x2D *) - (* maps in32 to VT_HRESULT *) - | NCustom of int - -and variantsig = - | VT_EMPTY (* 0x00 *) - (* No *) - | VT_NULL (* 0x01 *) - (* No null *) - | VT_I2 (* 0x02 *) - (* Yes int16 *) - | VT_I4 (* 0x03 *) - (* Yes int32 *) - | VT_R4 (* 0x04 *) - (* Yes float32 *) - | VT_R8 (* 0x05 *) - (* Yes float64 *) - | VT_CY (* 0x06 *) - (* Yes currency *) - | VT_DATE (* 0x07 *) - (* Yes date *) - | VT_BSTR (* 0x08 *) - (* Yes bstr *) - | VT_DISPATCH (* 0x09 *) - (* Yes idispatch *) - | VT_ERROR (* 0x0A *) - (* Yes error *) - | VT_BOOL (* 0x0B *) - (* Yes bool *) - | VT_VARIANT (* 0x0C *) - (* Yes variant *) - | VT_UNKNOWN (* 0x0D *) - (* Yes iunknown *) - | VT_DECIMAL (* 0x0E *) - (* Yes decimal *) - | VT_I1 (* 0x10 *) - (* Yes int8 *) - | VT_UI1 (* 0x11 *) - (* Yes unsigned int8, uint8 *) - | VT_UI2 (* 0x12 *) - (* Yes unsigned int16, uint16 *) - | VT_UI4 (* 0x13 *) - (* Yes unsigned int32, uint32 *) - | VT_I8 (* 0x14 *) - (* No int64 *) - | VT_UI8 (* 0x15 *) - (* No unsigned int64, uint64 *) - | VT_INT (* 0x16 *) - (* Yes int *) - | VT_UINT (* 0x17 *) - (* Yes unsigned int, uint *) - | VT_VOID (* 0x18 *) - (* No void *) - | VT_HRESULT (* 0x19 *) - (* No hresult *) - | VT_PTR (* 0x1A *) - (* No * *) - | VT_SAFEARRAY (* 0x1B *) - (* No safearray *) - | VT_CARRAY (* 0x1C *) - (* No carray *) - | VT_USERDEFINED (* 0x1D *) - (* No userdefined *) - | VT_LPSTR (* 0x1E *) - (* No lpstr *) - | VT_LPWSTR (* 0x1F *) - (* No lpwstr *) - | VT_RECORD (* 0x24 *) - (* Yes record *) - | VT_FILETIME (* 0x40 *) - (* No filetime *) - | VT_BLOB (* 0x41 *) - (* No blob *) - | VT_STREAM (* 0x42 *) - (* No stream *) - | VT_STORAGE (* 0x43 *) - (* No storage *) - | VT_STREAMED_OBJECT (* 0x44 *) - (* No streamed_object *) - | VT_STORED_OBJECT (* 0x45 *) - (* No stored_object *) - | VT_BLOB_OBJECT (* 0x46 *) - (* No blob_object *) - | VT_CF (* 0x47 *) - (* No cf *) - | VT_CLSID (* 0x48 *) - (* No clsid *) - (* | VT_VECTOR of variantsig (* 0x1000 *) *) - (* (* Yes vector *) *) - (* | VT_ARRAY of variantsig (* 0x2000 *) *) - (* (* Yes [ ] *) *) - (* | VT_BYREF of variantsig (* 0x4000 *) *) - (* (* Yes & *) *) diff --git a/libs/ilib/ilMetaDebug.ml b/libs/ilib/ilMetaDebug.ml deleted file mode 100644 index 023a14e5aae..00000000000 --- a/libs/ilib/ilMetaDebug.ml +++ /dev/null @@ -1,24 +0,0 @@ -(* - * This file is part of ilLib - * Copyright (c)2004-2013 Haxe Foundation - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA - *) -open IlMeta;; -open IlMetaTools;; - -let path_s = IlMetaTools.path_s -let ilsig_s = IlMetaTools.ilsig_s -let instance_s = IlMetaTools.instance_s diff --git a/libs/ilib/ilMetaReader.ml b/libs/ilib/ilMetaReader.ml deleted file mode 100644 index 24a954cd395..00000000000 --- a/libs/ilib/ilMetaReader.ml +++ /dev/null @@ -1,2406 +0,0 @@ -(* - * This file is part of ilLib - * Copyright (c)2004-2013 Haxe Foundation - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA - *) - -open PeData;; -open PeReader;; -open IlMeta;; -open IO;; -open Printf;; -open IlMetaTools;; -open ExtString;; -open IlData;; - -(* *) -let get_field = function - | Field f -> f - | _ -> assert false - -let get_method = function - | Method m -> m - | _ -> assert false - -let get_param = function - | Param p -> p - | _ -> assert false - -let get_type_def = function - | TypeDef p -> p - | _ -> assert false - -let get_event = function - | Event e -> e - | _ -> assert false - -let get_property = function - | Property p -> p - | _ -> assert false - -let get_module_ref = function - | ModuleRef r -> r - | _ -> assert false - -let get_assembly_ref = function - | AssemblyRef r -> r - | _ -> assert false - -let get_generic_param = function - | GenericParam p -> p - | _ -> assert false - -(* decoding helpers *) -let type_def_vis_of_int i = match i land 0x7 with - (* visibility flags - mask 0x7 *) - | 0x0 -> VPrivate (* 0x0 *) - | 0x1 -> VPublic (* 0x1 *) - | 0x2 -> VNestedPublic (* 0x2 *) - | 0x3 -> VNestedPrivate (* 0x3 *) - | 0x4 -> VNestedFamily (* 0x4 *) - | 0x5 -> VNestedAssembly (* 0x5 *) - | 0x6 -> VNestedFamAndAssem (* 0x6 *) - | 0x7 -> VNestedFamOrAssem (* 0x7 *) - | _ -> assert false - -let type_def_layout_of_int i = match i land 0x18 with - (* layout flags - mask 0x18 *) - | 0x0 -> LAuto (* 0x0 *) - | 0x8 -> LSequential (* 0x8 *) - | 0x10 -> LExplicit (* 0x10 *) - | _ -> assert false - -let type_def_semantics_of_int iprops = List.fold_left (fun acc i -> - if (iprops land i) = i then (match i with - (* semantics flags - mask 0x5A0 *) - | 0x20 -> SInterface (* 0x20 *) - | 0x80 -> SAbstract (* 0x80 *) - | 0x100 -> SSealed (* 0x100 *) - | 0x400 -> SSpecialName (* 0x400 *) - | _ -> assert false) :: acc - else - acc) [] [0x20;0x80;0x100;0x400] - -let type_def_impl_of_int iprops = List.fold_left (fun acc i -> - if (iprops land i) = i then (match i with - (* type implementation flags - mask 0x103000 *) - | 0x1000 -> IImport (* 0x1000 *) - | 0x2000 -> ISerializable (* 0x2000 *) - | 0x00100000 -> IBeforeFieldInit (* 0x00100000 *) - | _ -> assert false) :: acc - else - acc) [] [0x1000;0x2000;0x00100000] - -let type_def_string_of_int i = match i land 0x00030000 with - (* string formatting flags - mask 0x00030000 *) - | 0x0 -> SAnsi (* 0x0 *) - | 0x00010000 -> SUnicode (* 0x00010000 *) - | 0x00020000 -> SAutoChar (* 0x00020000 *) - | _ -> assert false - -let type_def_flags_of_int i = - { - tdf_vis = type_def_vis_of_int i; - tdf_layout = type_def_layout_of_int i; - tdf_semantics = type_def_semantics_of_int i; - tdf_impl = type_def_impl_of_int i; - tdf_string = type_def_string_of_int i; - } - -let null_type_def_flags = type_def_flags_of_int 0 - -let field_access_of_int i = match i land 0x07 with - (* access flags - mask 0x07 *) - | 0x0 -> FAPrivateScope (* 0x0 *) - | 0x1 -> FAPrivate (* 0x1 *) - | 0x2 -> FAFamAndAssem (* 0x2 *) - | 0x3 -> FAAssembly (* 0x3 *) - | 0x4 -> FAFamily (* 0x4 *) - | 0x5 -> FAFamOrAssem (* 0x5 *) - | 0x6 -> FAPublic (* 0x6 *) - | _ -> assert false - -let field_contract_of_int iprops = List.fold_left (fun acc i -> - if (iprops land i) = i then (match i with - (* contract flags - mask 0x02F0 *) - | 0x10 -> CStatic (* 0x10 *) - | 0x20 -> CInitOnly (* 0x20 *) - | 0x40 -> CLiteral (* 0x40 *) - | 0x80 -> CNotSerialized (* 0x80 *) - | 0x200 -> CSpecialName (* 0x200 *) - | _ -> assert false) :: acc - else - acc) [] [0x10;0x20;0x40;0x80;0x200] - -let field_reserved_of_int iprops = List.fold_left (fun acc i -> - if (iprops land i) = i then (match i with - (* reserved flags - cannot be set explicitly. mask 0x9500 *) - | 0x400 -> RSpecialName (* 0x400 *) - | 0x1000 -> RMarshal (* 0x1000 *) - | 0x8000 -> RConstant (* 0x8000 *) - | 0x0100 -> RFieldRVA (* 0x0100 *) - | _ -> assert false) :: acc - else - acc) [] [0x400;0x1000;0x8000;0x100] - -let field_flags_of_int i = - { - ff_access = field_access_of_int i; - ff_contract = field_contract_of_int i; - ff_reserved = field_reserved_of_int i; - } - -let null_field_flags = field_flags_of_int 0 - -let method_contract_of_int iprops = List.fold_left (fun acc i -> - if (iprops land i) = i then (match i with - (* contract flags - mask 0xF0 *) - | 0x10 -> CMStatic (* 0x10 *) - | 0x20 -> CMFinal (* 0x20 *) - | 0x40 -> CMVirtual (* 0x40 *) - | 0x80 -> CMHideBySig (* 0x80 *) - | _ -> assert false) :: acc - else - acc) [] [0x10;0x20;0x40;0x80] - -let method_vtable_of_int iprops = List.fold_left (fun acc i -> - if (iprops land i) = i then (match i with - (* vtable flags - mask 0x300 *) - | 0x100 -> VNewSlot (* 0x100 *) - | 0x200 -> VStrict (* 0x200 *) - | _ -> assert false) :: acc - else - acc) [] [0x100;0x200] - -let method_impl_of_int iprops = List.fold_left (fun acc i -> - if (iprops land i) = i then (match i with - (* implementation flags - mask 0x2C08 *) - | 0x0400 -> IAbstract (* 0x0400 *) - | 0x0800 -> ISpecialName (* 0x0800 *) - | 0x2000 -> IPInvokeImpl (* 0x2000 *) - | 0x0008 -> IUnmanagedExp (* 0x0008 *) - | _ -> assert false) :: acc - else - acc) [] [0x0400;0x0800;0x2000;0x0008] - -let method_reserved_of_int iprops = List.fold_left (fun acc i -> - if (iprops land i) = i then (match i with - (* reserved flags - cannot be set explicitly. mask 0xD000 *) - | 0x1000 -> RTSpecialName (* 0x1000 *) - | 0x4000 -> RHasSecurity (* 0x4000 *) - | 0x8000 -> RReqSecObj (* 0x8000 *) - | _ -> assert false) :: acc - else - acc) [] [0x1000;0x4000;0x8000] - -let method_code_type_of_int i = match i land 0x3 with - | 0x0 -> CCil (* 0x0 *) - | 0x1 -> CNative (* 0x1 *) - | 0x2 -> COptIl (* 0x2 *) - | 0x3 -> CRuntime (* 0x3 *) - | _ -> assert false - -let method_code_mngmt_of_int i = match i land 0x4 with - | 0x0 -> MManaged (* 0x0 *) - | 0x4 -> MUnmanaged (* 0x4 *) - | _ -> assert false - -let method_interop_of_int iprops = List.fold_left (fun acc i -> - if (iprops land i) = i then (match i with - | 0x10 -> OForwardRef (* 0x10 *) - | 0x80 -> OPreserveSig (* 0x80 *) - | 0x1000 -> OInternalCall (* 0x1000 *) - | 0x20 -> OSynchronized (* 0x20 *) - | 0x08 -> ONoInlining (* 0x08 *) - | _ -> assert false) :: acc - else - acc) [] [0x10;0x80;0x1000;0x20;0x08] - -let method_flags_of_int iflags flags = - { - mf_access = field_access_of_int flags; - mf_contract = method_contract_of_int flags; - mf_vtable = method_vtable_of_int flags; - mf_impl = method_impl_of_int flags; - mf_reserved = method_reserved_of_int flags; - mf_code_type = method_code_type_of_int iflags; - mf_code_mngmt = method_code_mngmt_of_int iflags; - mf_interop = method_interop_of_int iflags; - } - -let null_method_flags = method_flags_of_int 0 0 - -let param_io_of_int iprops = List.fold_left (fun acc i -> - if (iprops land i) = i then (match i with - (* input/output flags - mask 0x13 *) - | 0x1 -> PIn (* 0x1 *) - | 0x2 -> POut (* 0x2 *) - | 0x10 -> POpt (* 0x10 *) - | _ -> assert false) :: acc - else - acc) [] [0x1;0x2;0x10] - -let param_reserved_of_int iprops = List.fold_left (fun acc i -> - if (iprops land i) = i then (match i with - (* reserved flags - mask 0xF000 *) - | 0x1000 -> PHasConstant (* 0x1000 *) - | 0x2000 -> PMarshal (* 0x2000 *) - | _ -> assert false) :: acc - else - acc) [] [0x1000;0x2000] - -let param_flags_of_int i = - { - pf_io = param_io_of_int i; - pf_reserved = param_reserved_of_int i; - } - -let null_param_flags = param_flags_of_int 0 - -let callconv_of_int ?match_generic_inst:(match_generic_inst=false) i = - let basic = match i land 0xF with - | 0x0 -> CallDefault (* 0x0 *) - | 0x1 -> CallCDecl - | 0x2 -> CallStdCall - | 0x3 -> CallThisCall - | 0x4 -> CallFastCall - | 0x5 -> CallVararg (* 0x5 *) - | 0x6 -> CallField (* 0x6 *) - | 0x7 -> CallLocal (* 0x7 *) - | 0x8 -> CallProp (* 0x8 *) - | 0x9 -> CallUnmanaged (* 0x9 *) - | 0xa when match_generic_inst -> CallGenericInst (* 0xA *) - | i -> printf "error 0x%x\n\n" i; assert false - in - match i land 0x20 with - | 0x20 -> - [CallHasThis;basic] - | _ when i land 0x40 = 0x40 -> - [CallExplicitThis;basic] - | _ -> [basic] - -let event_flags_of_int iprops = List.fold_left (fun acc i -> - if (iprops land i) = i then (match i with - | 0x0200 -> ESpecialName (* 0x0200 *) - | 0x0400 -> ERTSpecialName (* 0x0400 *) - | _ -> assert false) :: acc - else - acc) [] [0x0200;0x0400] - -let property_flags_of_int iprops = List.fold_left (fun acc i -> - if (iprops land i) = i then (match i with - | 0x0200 -> PSpecialName (* 0x0200 *) - | 0x0400 -> PRTSpecialName (* 0x0400 *) - | 0x1000 -> PHasDefault (* 0x1000 *) - | 0xE9FF -> PUnused (* 0xE9FF *) - | _ -> assert false) :: acc - else - acc) [] [0x0200;0x0400;0x1000;0xE9FF] - -let semantic_flags_of_int iprops = List.fold_left (fun acc i -> - if (iprops land i) = i then (match i with - | 0x0001 -> SSetter (* 0x0001 *) - | 0x0002 -> SGetter (* 0x0002 *) - | 0x0004 -> SOther (* 0x0004 *) - | 0x0008 -> SAddOn (* 0x0008 *) - | 0x0010 -> SRemoveOn (* 0x0010 *) - | 0x0020 -> SFire (* 0x0020 *) - | _ -> assert false) :: acc - else - acc) [] [0x0001;0x0002;0x0004;0x0008;0x0010;0x0020] - -let impl_charset_of_int = function - | 0x0 -> IDefault (* 0x0 *) - | 0x2 -> IAnsi (* 0x2 *) - | 0x4 -> IUnicode (* 0x4 *) - | 0x6 -> IAutoChar (* 0x6 *) - | _ -> assert false - -let impl_callconv_of_int = function - | 0x0 -> IDefaultCall (* 0x0 *) - | 0x100 -> IWinApi (* 0x100 *) - | 0x200 -> ICDecl (* 0x200 *) - | 0x300 -> IStdCall (* 0x300 *) - | 0x400 -> IThisCall (* 0x400 *) - | 0x500 -> IFastCall (* 0x500 *) - | _ -> assert false - -let impl_flag_of_int iprops = List.fold_left (fun acc i -> - if (iprops land i) = i then (match i with - | 0x1 -> INoMangle (* 0x1 *) - | 0x10 -> IBestFit (* 0x10 *) - | 0x20 -> IBestFitOff (* 0x20 *) - | 0x40 -> ILastErr (* 0x40 *) - | 0x1000 -> ICharMapError (* 0x1000 *) - | 0x2000 -> ICharMapErrorOff (* 0x2000 *) - | _ -> assert false) :: acc - else - acc) [] [0x1;0x10;0x20;0x40;0x1000;0x2000] - -let impl_flags_of_int i = - { - if_charset = impl_charset_of_int (i land 0x6); - if_callconv = impl_callconv_of_int (i land 0x700); - if_flags = impl_flag_of_int i; - } - -let null_impl_flags = impl_flags_of_int 0 - -let assembly_flags_of_int iprops = List.fold_left (fun acc i -> - if (iprops land i) = i then (match i with - | 0x1 -> APublicKey (* 0x1 *) - | 0x100 -> ARetargetable (* 0x100 *) - | 0x4000 -> ADisableJitCompileOptimizer (* 0x4000 *) - | 0x8000 -> AEnableJitCompileTracking (* 0x8000 *) - | _ -> assert false) :: acc - else - acc) [] [0x1;0x100;0x4000;0x8000] - -let hash_algo_of_int = function - | 0x0 -> HNone (* 0x0 *) - | 0x8003 -> HReserved (* 0x8003 *) - | 0x8004 -> HSha1 (* 0x8004 *) - | _ -> assert false - -let file_flag_of_int = function - | 0x0 -> ContainsMetadata (* 0x0 *) - | 0x1 -> ContainsNoMetadata (* 0x1 *) - | _ -> assert false - -let manifest_resource_flag_of_int i = match i land 0x7 with - | 0x0 -> RNone (* 0x0 *) - | 0x1 -> RPublic (* 0x1 *) - | 0x2 -> RPrivate (* 0x2 *) - | _ -> assert false - -let generic_variance_of_int = function - (* mask 0x3 *) - | 0x0 -> VNone (* 0x0 *) - | 0x1 -> VCovariant (* 0x1 *) - | 0x2 -> VContravariant (* 0x2 *) - | _ -> assert false - -let generic_constraint_of_int iprops = List.fold_left (fun acc i -> - if (iprops land i) = i then (match i with - (* mask 0x1C *) - | 0x4 -> CInstanceType (* 0x4 *) - | 0x8 -> CValueType (* 0x8 *) - | 0x10 -> CDefaultCtor (* 0x10 *) - | _ -> assert false) :: acc - else - acc) [] [0x4;0x8;0x10] - -let generic_flags_of_int i = - { - gf_variance = generic_variance_of_int (i land 0x3); - gf_constraint = generic_constraint_of_int (i land 0x1C); - } - -let null_generic_flags = generic_flags_of_int 0 - -(* TODO: convert from string to Bigstring if OCaml 4 is available *) -type meta_ctx = { - compressed : bool; - (* is a compressed stream *) - strings_stream : string; - mutable strings_offset : int; - (* #Strings: a string heap containing the names of metadata items *) - blob_stream : string; - mutable blob_offset : int; - (* #Blob: blob heap containing internal metadata binary object, such as default values, signatures, etc *) - guid_stream : string; - mutable guid_offset : int; - (* #GUID: a GUID heap *) - us_stream : string; - (* #US: user-defined strings *) - meta_stream : string; - (* may be either: *) - (* #~: compressed (optimized) metadata stream *) - (* #-: uncompressed (unoptimized) metadata stream *) - mutable meta_edit_continue : bool; - mutable meta_has_deleted : bool; - - module_cache : meta_cache; - tables : (clr_meta DynArray.t) array; - table_sizes : ( string -> int -> int * int ) array; - extra_streams : clr_stream_header list; - relations : (meta_pointer, clr_meta) Hashtbl.t; - typedefs : (ilpath, meta_type_def) Hashtbl.t; - - mutable delays : (unit -> unit) list; -} - -and meta_cache = { - mutable lookups : (string -> meta_ctx option) list; - mutable mcache : (meta_module * meta_ctx) list; -} - -let empty = "" - -let create_cache () = - { - lookups = []; - mcache = []; - } - -let add_lookup cache fn = - cache.lookups <- fn :: cache.lookups - -(* ******* Reading from Strings ********* *) - -let sget s pos = Char.code (String.get s pos) - -let read_compressed_i32 s pos = - let v = sget s pos in - (* Printf.printf "compressed: %x (18 0x%x 19 0x%x)\n" v (sget s (pos+20)) (sget s (pos+21)); *) - if v land 0x80 = 0x00 then - pos+1, v - else if v land 0xC0 = 0x80 then - pos+2, ((v land 0x3F) lsl 8) lor (sget s (pos+1)) - else if v land 0xE0 = 0xC0 then - pos+4, ((v land 0x1F) lsl 24) lor ((sget s (pos+1)) lsl 16) lor ((sget s (pos+2)) lsl 8) lor (sget s (pos+3)) - else - error (Printf.sprintf "Error reading compressed data. Invalid first byte: %x" v) - -let int_of_table (idx : clr_meta_idx) : int = Obj.magic idx -let table_of_int (idx : int) : clr_meta_idx = Obj.magic idx - -let sread_ui8 s pos = - let n1 = sget s pos in - pos+1,n1 - -let sread_i32 s pos = - let n1 = sget s pos in - let n2 = sget s (pos+1) in - let n3 = sget s (pos+2) in - let n4 = sget s (pos+3) in - pos+4, (n4 lsl 24) lor (n3 lsl 16) lor (n2 lsl 8) lor n1 - -let sread_real_i32 s pos = - let n1 = sget s pos in - let n2 = sget s (pos+1) in - let n3 = sget s (pos+2) in - let n4 = Int32.of_int (sget s (pos+3)) in - let n = Int32.of_int ((n3 lsl 16) lor (n2 lsl 8) lor n1) in - let n4 = Int32.shift_left n4 24 in - pos+4, (Int32.logor n4 n) - -let sread_i64 s pos = - let pos, v1 = sread_real_i32 s (pos+1) in - let v1 = Int64.of_int32 v1 in - let pos, v2 = sread_real_i32 s pos in - let v2 = Int64.of_int32 v2 in - let v2 = Int64.shift_left v2 32 in - pos, (Int64.logor v1 v2) - -let sread_ui16 s pos = - let n1 = sget s pos in - let n2 = sget s (pos+1) in - pos+2, (n2 lsl 8) lor n1 - -let read_cstring ctx pos = - let s = ctx.strings_stream in - let rec loop en = - match String.get s en with - | '\x00' -> en - pos - | _ -> loop (en+1) - in - (* printf "len 0x%x - pos 0x%x\n" (String.length s) pos; *) - let len = loop pos in - String.sub s pos len - -let read_sstring_idx ctx pos = - let s = ctx.meta_stream in - let metapos,i = if ctx.strings_offset = 2 then - sread_ui16 s pos - else - sread_i32 s pos - in - match i with - | 0 -> - metapos, "" - | _ -> - metapos, read_cstring ctx i - -let read_sblob_idx ctx pos = - let s = ctx.meta_stream in - let metapos, i = if ctx.blob_offset = 2 then - sread_ui16 s pos - else - sread_i32 s pos - in - match i with - | 0 -> - metapos,"" - | _ -> - let bpos, len = read_compressed_i32 ctx.blob_stream i in - metapos, String.sub ctx.blob_stream bpos len - -let read_sguid_idx ctx pos = - let s = ctx.meta_stream in - let metapos,i = if ctx.guid_offset = 2 then - sread_ui16 s pos - else - sread_i32 s pos - in - match i with - | 0 -> - metapos, "" - | _ -> - let s = ctx.guid_stream in - let i = i - 1 in - let pos = i * 16 in - metapos, String.sub s pos 16 - -let read_callconv ctx s pos = - let pos, conv = read_compressed_i32 s pos in - let callconv = callconv_of_int conv ~match_generic_inst:true in - let pos = match conv land 0x10 with - | 0x10 -> fst (read_compressed_i32 s pos) - | _ -> pos - in - pos, callconv - -let read_constant ctx with_type s pos = - match with_type with - | CBool -> - pos+1, IBool (sget s (pos) <> 0) - | CChar -> - let pos, v = sread_ui16 s (pos) in - pos, IChar v - | CInt8 | CUInt8 -> - pos+1,IByte (sget s (pos)) - | CInt16 | CUInt16 -> - let pos, v = sread_ui16 s (pos) in - pos, IShort v - | CInt32 | CUInt32 -> - let pos, v = sread_real_i32 s (pos) in - pos, IInt v - | CInt64 | CUInt64 -> - let pos, v = sread_i64 s (pos) in - pos, IInt64 v - | CFloat32 -> - let pos, v1 = sread_real_i32 s (pos) in - pos, IFloat32 (Int32.float_of_bits v1) - | CFloat64 -> - let pos, v1 = sread_i64 s (pos) in - pos, IFloat64 (Int64.float_of_bits v1) - | CString -> - if sget s pos = 0xff then - pos+1,IString "" - else - let pos, len = read_compressed_i32 s pos in - pos+len, IString (String.sub s pos len) - | CNullRef -> - pos+1, INull - -let sig_to_const = function - | SBool -> CBool - | SChar -> CChar - | SInt8 -> CInt8 - | SUInt8 -> CUInt8 - | SInt16 -> CInt16 - | SUInt16 -> CUInt16 - | SInt32 -> CInt32 - | SUInt32 -> CUInt32 - | SInt64 -> CInt64 - | SUInt64 -> CUInt64 - | SFloat32 -> CFloat32 - | SFloat64 -> CFloat64 - | SString -> CString - | _ -> CNullRef - -let read_constant_type ctx s pos = match sget s pos with - | 0x2 -> pos+1, CBool (* 0x2 *) - | 0x3 -> pos+1, CChar (* 0x3 *) - | 0x4 -> pos+1, CInt8 (* 0x4 *) - | 0x5 -> pos+1, CUInt8 (* 0x5 *) - | 0x6 -> pos+1, CInt16 (* 0x6 *) - | 0x7 -> pos+1, CUInt16 (* 0x7 *) - | 0x8 -> pos+1, CInt32 (* 0x8 *) - | 0x9 -> pos+1, CUInt32 (* 0x9 *) - | 0xA -> pos+1, CInt64 (* 0xA *) - | 0xB -> pos+1, CUInt64 (* 0xB *) - | 0xC -> pos+1, CFloat32 (* 0xC *) - | 0xD -> pos+1, CFloat64 (* 0xD *) - | 0xE -> pos+1, CString (* 0xE *) - | 0x12 -> pos+1, CNullRef (* 0x12 *) - | i -> Printf.printf "0x%x\n" i; assert false - -let action_security_of_int = function - | 0x1 -> SecRequest (* 0x1 *) - | 0x2 -> SecDemand (* 0x2 *) - | 0x3 -> SecAssert (* 0x3 *) - | 0x4 -> SecDeny (* 0x4 *) - | 0x5 -> SecPermitOnly (* 0x5 *) - | 0x6 -> SecLinkCheck (* 0x6 *) - | 0x7 -> SecInheritCheck (* 0x7 *) - | 0x8 -> SecReqMin (* 0x8 *) - | 0x9 -> SecReqOpt (* 0x9 *) - | 0xA -> SecReqRefuse (* 0xA *) - | 0xB -> SecPreJitGrant (* 0xB *) - | 0xC -> SecPreJitDeny (* 0xC *) - | 0xD -> SecNonCasDemand (* 0xD *) - | 0xE -> SecNonCasLinkDemand (* 0xE *) - | 0xF -> SecNonCasInheritance (* 0xF *) - | _ -> assert false - -(* ******* Metadata Tables ********* *) -let null_meta = UnknownMeta (-1) - -let mk_module id = - { - md_id = id; - md_generation = 0; - md_name = empty; - md_vid = empty; - md_encid = empty; - md_encbase_id = empty; - } - -let null_module = mk_module (-1) - -let mk_type_ref id = - { - tr_id = id; - tr_resolution_scope = null_meta; - tr_name = empty; - tr_namespace = []; - } - -let null_type_ref = mk_type_ref (-1) - -let mk_type_def id = - { - td_id = id; - td_flags = null_type_def_flags; - td_name = empty; - td_namespace = []; - td_extends = None; - td_field_list = []; - td_method_list = []; - td_extra_enclosing = None; - } - -let null_type_def = mk_type_def (-1) - -let mk_field id = - { - f_id = id; - f_flags = null_field_flags; - f_name = empty; - f_signature = SVoid; - } - -let null_field = mk_field (-1) - -let mk_field_ptr id = - { - fp_id = id; - fp_field = null_field; - } - -let null_field_ptr = mk_field_ptr (-1) - -let mk_method id = - { - m_id = id; - m_rva = Int32.of_int (-1); - m_flags = null_method_flags; - m_name = empty; - m_signature = SVoid; - m_param_list = []; - m_declaring = None; - } - -let null_method = mk_method (-1) - -let mk_method_ptr id = - { - mp_id = id; - mp_method = null_method; - } - -let null_method_ptr = mk_method_ptr (-1) - -let mk_param id = - { - p_id = id; - p_flags = null_param_flags; - p_sequence = -1; - p_name = empty; - } - -let null_param = mk_param (-1) - -let mk_param_ptr id = - { - pp_id = id; - pp_param = null_param; - } - -let null_param_ptr = mk_param_ptr (-1) - -let mk_interface_impl id = - { - ii_id = id; - ii_class = null_type_def; (* TypeDef rid *) - ii_interface = null_meta; - } - -let null_interface_impl = mk_interface_impl (-1) - -let mk_member_ref id = - { - memr_id = id; - memr_class = null_meta; - memr_name = empty; - memr_signature = SVoid; - } - -let null_member_ref = mk_member_ref (-1) - -let mk_constant id = - { - c_id = id; - c_type = CNullRef; - c_parent = null_meta; - c_value = INull; - } - -let null_constant = mk_constant (-1) - -let mk_custom_attribute id = - { - ca_id = id; - ca_parent = null_meta; - ca_type = null_meta; - ca_value = None; - } - -let null_custom_attribute = mk_custom_attribute (-1) - -let mk_field_marshal id = - { - fm_id = id; - fm_parent = null_meta; - fm_native_type = NVoid; - } - -let null_field_marshal = mk_field_marshal (-1) - -let mk_decl_security id = - { - ds_id = id; - ds_action = SecNull; - ds_parent = null_meta; - ds_permission_set = empty; - } - -let mk_class_layout id = - { - cl_id = id; - cl_packing_size = -1; - cl_class_size = -1; - cl_parent = null_type_def; - } - -let mk_field_layout id = - { - fl_id = id; - fl_offset = -1; - fl_field = null_field; - } - -let mk_stand_alone_sig id = - { - sa_id = id; - sa_signature = SVoid; - } - -let mk_event id = - { - e_id = id; - e_flags = []; - e_name = empty; - e_event_type = null_meta; - } - -let null_event = mk_event (-1) - -let mk_event_map id = - { - em_id = id; - em_parent = null_type_def; - em_event_list = []; - } - -let mk_event_ptr id = - { - ep_id = id; - ep_event = null_event; - } - -let mk_property id = - { - prop_id = id; - prop_flags = []; - prop_name = empty; - prop_type = SVoid; - } - -let null_property = mk_property (-1) - -let mk_property_map id = - { - pm_id = id; - pm_parent = null_type_def; - pm_property_list = []; - } - -let mk_property_ptr id = - { - prp_id = id; - prp_property = null_property; - } - -let mk_method_semantics id = - { - ms_id = id; - ms_semantic = []; - ms_method = null_method; - ms_association = null_meta; - } - -let mk_method_impl id = - { - mi_id = id; - mi_class = null_type_def; - mi_method_body = null_meta; - mi_method_declaration = null_meta; - } - -let mk_module_ref id = - { - modr_id = id; - modr_name = empty; - } - -let null_module_ref = mk_module_ref (-1) - -let mk_type_spec id = - { - ts_id = id; - ts_signature = SVoid; - } - -let mk_enc_log id = - { - el_id = id; - el_token = -1; - el_func_code = -1; - } - -let mk_impl_map id = - { - im_id = id; - im_flags = null_impl_flags; - im_forwarded = null_meta; - im_import_name = empty; - im_import_scope = null_module_ref; - } - -let mk_enc_map id = - { - encm_id = id; - encm_token = -1; - } - -let mk_field_rva id = - { - fr_id = id; - fr_rva = Int32.zero; - fr_field = null_field; - } - -let mk_assembly id = - { - a_id = id; - a_hash_algo = HNone; - a_major = -1; - a_minor = -1; - a_build = -1; - a_rev = -1; - a_flags = []; - a_public_key = empty; - a_name = empty; - a_locale = empty; - } - -let mk_assembly_processor id = - { - ap_id = id; - ap_processor = -1; - } - -let mk_assembly_os id = - { - aos_id = id; - aos_platform_id = -1; - aos_major_version = -1; - aos_minor_version = -1; - } - -let mk_assembly_ref id = - { - ar_id = id; - ar_major = -1; - ar_minor = -1; - ar_build = -1; - ar_rev = -1; - ar_flags = []; - ar_public_key = empty; - ar_name = empty; - ar_locale = empty; - ar_hash_value = empty; - } - -let null_assembly_ref = mk_assembly_ref (-1) - -let mk_assembly_ref_processor id = - { - arp_id = id; - arp_processor = -1; - arp_assembly_ref = null_assembly_ref; - } - -let mk_assembly_ref_os id = - { - aros_id = id; - aros_platform_id = -1; - aros_major = -1; - aros_minor = -1; - aros_assembly_ref = null_assembly_ref; - } - -let mk_file id = - { - file_id = id; - file_flags = ContainsMetadata; - file_name = empty; - file_hash_value = empty; - } - -let mk_exported_type id = - { - et_id = id; - et_flags = null_type_def_flags; - et_type_def_id = -1; - et_type_name = empty; - et_type_namespace = []; - et_implementation = null_meta; - } - -let mk_manifest_resource id = - { - mr_id = id; - mr_offset = -1; - mr_flags = RNone; - mr_name = empty; - mr_implementation = None; - } - -let mk_nested_class id = - { - nc_id = id; - nc_nested = null_type_def; - nc_enclosing = null_type_def; - } - -let mk_generic_param id = - { - gp_id = id; - gp_number = -1; - gp_flags = null_generic_flags; - gp_owner = null_meta; - gp_name = None; - } - -let null_generic_param = mk_generic_param (-1) - -let mk_method_spec id = - { - mspec_id = id; - mspec_method = null_meta; - mspec_instantiation = SVoid; - } - -let mk_generic_param_constraint id = - { - gc_id = id; - gc_owner = null_generic_param; - gc_constraint = null_meta; - } - -let mk_meta tbl id = match tbl with - | IModule -> Module (mk_module id) - | ITypeRef -> TypeRef (mk_type_ref id) - | ITypeDef -> TypeDef (mk_type_def id) - | IFieldPtr -> FieldPtr (mk_field_ptr id) - | IField -> Field (mk_field id) - | IMethodPtr -> MethodPtr (mk_method_ptr id) - | IMethod -> Method (mk_method id) - | IParamPtr -> ParamPtr (mk_param_ptr id) - | IParam -> Param (mk_param id) - | IInterfaceImpl -> InterfaceImpl (mk_interface_impl id) - | IMemberRef -> MemberRef (mk_member_ref id) - | IConstant -> Constant (mk_constant id) - | ICustomAttribute -> CustomAttribute (mk_custom_attribute id) - | IFieldMarshal -> FieldMarshal(mk_field_marshal id) - | IDeclSecurity -> DeclSecurity(mk_decl_security id) - | IClassLayout -> ClassLayout(mk_class_layout id) - | IFieldLayout -> FieldLayout(mk_field_layout id) - | IStandAloneSig -> StandAloneSig(mk_stand_alone_sig id) - | IEventMap -> EventMap(mk_event_map id) - | IEventPtr -> EventPtr(mk_event_ptr id) - | IEvent -> Event(mk_event id) - | IPropertyMap -> PropertyMap(mk_property_map id) - | IPropertyPtr -> PropertyPtr(mk_property_ptr id) - | IProperty -> Property(mk_property id) - | IMethodSemantics -> MethodSemantics(mk_method_semantics id) - | IMethodImpl -> MethodImpl(mk_method_impl id) - | IModuleRef -> ModuleRef(mk_module_ref id) - | ITypeSpec -> TypeSpec(mk_type_spec id) - | IImplMap -> ImplMap(mk_impl_map id) - | IFieldRVA -> FieldRVA(mk_field_rva id) - | IENCLog -> ENCLog(mk_enc_log id) - | IENCMap -> ENCMap(mk_enc_map id) - | IAssembly -> Assembly(mk_assembly id) - | IAssemblyProcessor -> AssemblyProcessor(mk_assembly_processor id) - | IAssemblyOS -> AssemblyOS(mk_assembly_os id) - | IAssemblyRef -> AssemblyRef(mk_assembly_ref id) - | IAssemblyRefProcessor -> AssemblyRefProcessor(mk_assembly_ref_processor id) - | IAssemblyRefOS -> AssemblyRefOS(mk_assembly_ref_os id) - | IFile -> File(mk_file id) - | IExportedType -> ExportedType(mk_exported_type id) - | IManifestResource -> ManifestResource(mk_manifest_resource id) - | INestedClass -> NestedClass(mk_nested_class id) - | IGenericParam -> GenericParam(mk_generic_param id) - | IMethodSpec -> MethodSpec(mk_method_spec id) - | IGenericParamConstraint -> GenericParamConstraint(mk_generic_param_constraint id) - | i -> UnknownMeta (int_of_table i) - -let get_table ctx idx rid = - let cur = ctx.tables.(int_of_table idx) in - DynArray.get cur (rid-1) - -(* special coded types *) -let max_clr_meta_idx = 76 - -let coded_description = Array.init (max_clr_meta_idx - 63) (fun i -> - let i = 64 + i in - match table_of_int i with - | ITypeDefOrRef -> - Array.of_list [ITypeDef;ITypeRef;ITypeSpec], 2 - | IHasConstant -> - Array.of_list [IField;IParam;IProperty], 2 - | IHasCustomAttribute -> - Array.of_list - [IMethod;IField;ITypeRef;ITypeDef;IParam;IInterfaceImpl;IMemberRef; - IModule;IDeclSecurity;IProperty;IEvent;IStandAloneSig;IModuleRef; - ITypeSpec;IAssembly;IAssemblyRef;IFile;IExportedType;IManifestResource; - IGenericParam;IGenericParamConstraint;IMethodSpec], 5 - | IHasFieldMarshal -> - Array.of_list [IField;IParam], 1 - | IHasDeclSecurity -> - Array.of_list [ITypeDef;IMethod;IAssembly], 2 - | IMemberRefParent -> - Array.of_list [ITypeDef;ITypeRef;IModuleRef;IMethod;ITypeSpec], 3 - | IHasSemantics -> - Array.of_list [IEvent;IProperty], 1 - | IMethodDefOrRef -> - Array.of_list [IMethod;IMemberRef], 1 - | IMemberForwarded -> - Array.of_list [IField;IMethod], 1 - | IImplementation -> - Array.of_list [IFile;IAssemblyRef;IExportedType], 2 - | ICustomAttributeType -> - Array.of_list [ITypeRef(* unused ? *);ITypeDef (* unused ? *);IMethod;IMemberRef(*;IString FIXME *)], 3 - | IResolutionScope -> - Array.of_list [IModule;IModuleRef;IAssemblyRef;ITypeRef], 2 - | ITypeOrMethodDef -> - Array.of_list [ITypeDef;IMethod], 1 - | _ -> - print_endline ("Unknown coded index: " ^ string_of_int i); - assert false) - -let set_coded_sizes ctx rows = - let check i tbls max = - if List.exists (fun t -> - let _, nrows = rows.(int_of_table t) in - nrows >= max - ) tbls then - ctx.table_sizes.(i) <- sread_i32 - in - for i = 64 to (max_clr_meta_idx) do - let tbls, size = coded_description.(i - 64) in - let max = 1 lsl (16 - size) in - check i (Array.to_list tbls) max - done - -let sread_from_table_opt ctx in_blob tbl s pos = - let i = int_of_table tbl in - let sread = if in_blob then - read_compressed_i32 - else - ctx.table_sizes.(i) - in - let pos, rid = sread s pos in - if i >= 64 then begin - let tbls,size = coded_description.(i-64) in - let mask = (1 lsl size) - 1 in - let mask = if mask = 0 then 1 else mask in - let tidx = rid land mask in - let real_rid = rid lsr size in - let real_tbl = tbls.(tidx) in - (* printf "rid 0x%x - table idx 0x%x - real_rid 0x%x\n\n" rid tidx real_rid; *) - if real_rid = 0 then - pos, None - else - pos, Some (get_table ctx real_tbl real_rid) - end else if rid = 0 then - pos, None - else - pos, Some (get_table ctx tbl rid) - -let sread_from_table ctx in_blob tbl s pos = - let pos, opt = sread_from_table_opt ctx in_blob tbl s pos in - pos, Option.get opt - -(* ******* SIGNATURE READING ********* *) -let read_inline_str s pos = - let pos, len = read_compressed_i32 s pos in - let ret = String.sub s pos len in - pos+len,ret - -let rec read_ilsig ctx s pos = - let i = sget s pos in - (* printf "0x%x\n" i; *) - let pos = pos + 1 in - match i with - | 0x1 -> pos, SVoid (* 0x1 *) - | 0x2 -> pos, SBool (* 0x2 *) - | 0x3 -> pos, SChar (* 0x3 *) - | 0x4 -> pos, SInt8 (* 0x4 *) - | 0x5 -> pos, SUInt8 (* 0x5 *) - | 0x6 -> pos, SInt16 (* 0x6 *) - | 0x7 -> pos, SUInt16 (* 0x7 *) - | 0x8 -> pos, SInt32 (* 0x8 *) - | 0x9 -> pos, SUInt32 (* 0x9 *) - | 0xA -> pos, SInt64 (* 0xA *) - | 0xB -> pos, SUInt64 (* 0xB *) - | 0xC -> pos, SFloat32 (* 0xC *) - | 0xD -> pos, SFloat64 (* 0xD *) - | 0xE -> pos, SString (* 0xE *) - | 0xF -> - let pos, s = read_ilsig ctx s pos in - pos, SPointer s - | 0x10 -> - let pos, s = read_ilsig ctx s pos in - pos, SManagedPointer s - | 0x11 -> - let pos, vt = sread_from_table ctx true ITypeDefOrRef s pos in - pos, SValueType vt - | 0x12 -> - let pos, c = sread_from_table ctx true ITypeDefOrRef s pos in - pos, SClass c - | 0x13 -> - let n = sget s pos in - pos + 1, STypeParam n - | 0x14 -> - let pos, ssig = read_ilsig ctx s pos in - let pos, rank = read_compressed_i32 s pos in - let pos, numsizes = read_compressed_i32 s pos in - let pos = ref pos in - let sizearray = Array.init numsizes (fun _ -> - let p, size = read_compressed_i32 s !pos in - pos := p; - size - ) in - let pos, bounds = read_compressed_i32 s !pos in - let pos = ref pos in - let boundsarray = Array.init bounds (fun _ -> - let p, b = read_compressed_i32 s !pos in - pos := p; - let signed = b land 0x1 = 0x1 in - let b = b lsr 1 in - if signed then -b else b - ) in - let ret = Array.init rank (fun i -> - (if i >= bounds then None else Some boundsarray.(i)) - , (if i >= numsizes then None else Some sizearray.(i)) - ) in - !pos, SArray(ssig, ret) - | 0x15 -> - (* let pos, c = sread_from_table ctx ITypeDefOrRef s pos in *) - let pos, ssig = read_ilsig ctx s pos in - let pos, ntypes = read_compressed_i32 s pos in - let rec loop acc pos n = - if n > ntypes then - pos, List.rev acc - else - let pos, ssig = read_ilsig ctx s pos in - loop (ssig :: acc) pos (n+1) - in - let pos, args = loop [] pos 1 in - pos, SGenericInst (ssig, args) - | 0x16 -> pos, STypedReference (* 0x16 *) - | 0x18 -> pos, SIntPtr (* 0x18 *) - | 0x19 -> pos, SUIntPtr (* 0x19 *) - | 0x1B -> - let pos, conv = read_compressed_i32 s pos in - let callconv = callconv_of_int conv in - let pos, ntypes = read_compressed_i32 s pos in - let pos, ret = read_ilsig ctx s pos in - let rec loop acc pos n = - if n >= ntypes then - pos, List.rev acc - else - let pos, ssig = read_ilsig ctx s pos in - loop (ssig :: acc) pos (n+1) - in - let pos, args = loop [] pos 1 in - pos, SFunPtr (callconv, ret, args) - | 0x1C -> pos, SObject (* 0x1C *) - | 0x1D -> - let pos, ssig = read_ilsig ctx s pos in - pos, SVector ssig - | 0x1E -> - let pos, conv = read_compressed_i32 s pos in - pos, SMethodTypeParam conv - | 0x1F -> - let pos, tdef = sread_from_table ctx true ITypeDefOrRef s pos in - let pos, ilsig = read_ilsig ctx s pos in - pos, SReqModifier (tdef, ilsig) - | 0x20 -> - let pos, tdef = sread_from_table ctx true ITypeDefOrRef s pos in - let pos, ilsig = read_ilsig ctx s pos in - pos, SOptModifier (tdef, ilsig) - | 0x41 -> pos, SSentinel (* 0x41 *) - | 0x45 -> - let pos, ssig = read_ilsig ctx s pos in - pos,SPinned ssig (* 0x45 *) - (* special undocumented constants *) - | 0x50 -> pos, SType - | 0x51 -> pos, SBoxed - | 0x55 -> - let pos, vt = read_inline_str s pos in - pos, SEnum vt - | _ -> - Printf.printf "unknown ilsig 0x%x\n\n" i; - assert false - -let rec read_variantsig ctx s pos = - let pos, b = sread_ui8 s pos in - match b with - | 0x00 -> pos, VT_EMPTY (* 0x00 *) - | 0x01 -> pos, VT_NULL (* 0x01 *) - | 0x02 -> pos, VT_I2 (* 0x02 *) - | 0x03 -> pos, VT_I4 (* 0x03 *) - | 0x04 -> pos, VT_R4 (* 0x04 *) - | 0x05 -> pos, VT_R8 (* 0x05 *) - | 0x06 -> pos, VT_CY (* 0x06 *) - | 0x07 -> pos, VT_DATE (* 0x07 *) - | 0x08 -> pos, VT_BSTR (* 0x08 *) - | 0x09 -> pos, VT_DISPATCH (* 0x09 *) - | 0x0A -> pos, VT_ERROR (* 0x0A *) - | 0x0B -> pos, VT_BOOL (* 0x0B *) - | 0x0C -> pos, VT_VARIANT (* 0x0C *) - | 0x0D -> pos, VT_UNKNOWN (* 0x0D *) - | 0x0E -> pos, VT_DECIMAL (* 0x0E *) - | 0x10 -> pos, VT_I1 (* 0x10 *) - | 0x11 -> pos, VT_UI1 (* 0x11 *) - | 0x12 -> pos, VT_UI2 (* 0x12 *) - | 0x13 -> pos, VT_UI4 (* 0x13 *) - | 0x14 -> pos, VT_I8 (* 0x14 *) - | 0x15 -> pos, VT_UI8 (* 0x15 *) - | 0x16 -> pos, VT_INT (* 0x16 *) - | 0x17 -> pos, VT_UINT (* 0x17 *) - | 0x18 -> pos, VT_VOID (* 0x18 *) - | 0x19 -> pos, VT_HRESULT (* 0x19 *) - | 0x1A -> pos, VT_PTR (* 0x1A *) - | 0x1B -> pos, VT_SAFEARRAY (* 0x1B *) - | 0x1C -> pos, VT_CARRAY (* 0x1C *) - | 0x1D -> pos, VT_USERDEFINED (* 0x1D *) - | 0x1E -> pos, VT_LPSTR (* 0x1E *) - | 0x1F -> pos, VT_LPWSTR (* 0x1F *) - | 0x24 -> pos, VT_RECORD (* 0x24 *) - | 0x40 -> pos, VT_FILETIME (* 0x40 *) - | 0x41 -> pos, VT_BLOB (* 0x41 *) - | 0x42 -> pos, VT_STREAM (* 0x42 *) - | 0x43 -> pos, VT_STORAGE (* 0x43 *) - | 0x44 -> pos, VT_STREAMED_OBJECT (* 0x44 *) - | 0x45 -> pos, VT_STORED_OBJECT (* 0x45 *) - | 0x46 -> pos, VT_BLOB_OBJECT (* 0x46 *) - | 0x47 -> pos, VT_CF (* 0x47 *) - | 0x48 -> pos, VT_CLSID (* 0x48 *) - | _ -> assert false - -let rec read_nativesig ctx s pos : int * nativesig = - let pos, b = sread_ui8 s pos in - match b with - | 0x01 -> pos, NVoid (* 0x01 *) - | 0x02 -> pos, NBool (* 0x02 *) - | 0x03 -> pos, NInt8 (* 0x03 *) - | 0x4 -> pos, NUInt8 (* 0x4 *) - | 0x5 -> pos, NInt16 (* 0x5 *) - | 0x6 -> pos, NUInt16 (* 0x6 *) - | 0x7 -> pos, NInt32 (* 0x7 *) - | 0x8 -> pos, NUInt32 (* 0x8 *) - | 0x9 -> pos, NInt64 (* 0x9 *) - | 0xA -> pos, NUInt64 (* 0xA *) - | 0xB -> pos, NFloat32 (* 0xB *) - | 0xC -> pos, NFloat64 (* 0xC *) - | 0xD -> pos, NSysChar (* 0xD *) - | 0xE -> pos, NVariant (* 0xE *) - | 0xF -> pos, NCurrency (* 0xF *) - | 0x10 -> pos, NPointer (* 0x10 *) - | 0x11 -> pos, NDecimal (* 0x11 *) - | 0x12 -> pos, NDate (* 0x12 *) - | 0x13 -> pos, NBStr (* 0x13 *) - | 0x14 -> pos, NLPStr (* 0x14 *) - | 0x15 -> pos, NLPWStr (* 0x15 *) - | 0x16 -> pos, NLPTStr (* 0x16 *) - | 0x17 -> - let pos, size = read_compressed_i32 s pos in - pos, NFixedString size - | 0x18 -> pos, NObjectRef (* 0x18 *) - | 0x19 -> pos, NUnknown (* 0x19 *) - | 0x1A -> pos, NDispatch (* 0x1A *) - | 0x1B -> pos, NStruct (* 0x1B *) - | 0x1C -> pos, NInterface (* 0x1C *) - | 0x1D -> - let pos, v = read_variantsig ctx s pos in - pos, NSafeArray v - | 0x1E -> - let pos, size = read_compressed_i32 s pos in - let pos, t = read_variantsig ctx s pos in - pos, NFixedArray (size,t) - | 0x1F -> pos, NIntPointer (* 0x1F *) - | 0x20 -> pos, NUIntPointer (* 0x20 *) - | 0x21 -> pos, NNestedStruct (* 0x21 *) - | 0x22 -> pos, NByValStr (* 0x22 *) - | 0x23 -> pos, NAnsiBStr (* 0x23 *) - | 0x24 -> pos, NTBStr (* 0x24 *) - | 0x25 -> pos, NVariantBool (* 0x25 *) - | 0x26 -> pos, NFunctionPtr (* 0x26 *) - | 0x28 -> pos, NAsAny (* 0x28 *) - | 0x2A -> - let pos, elt = read_nativesig ctx s pos in - let pos, paramidx = read_compressed_i32 s pos in - let pos, size = read_compressed_i32 s pos in - let pos, param_mult = read_compressed_i32 s pos in - pos, NArray(elt,paramidx,size,param_mult) - | 0x2B -> pos, NLPStruct (* 0x2B *) - | 0x2C -> - let pos, guid_val = read_inline_str s pos in - let pos, unmanaged = read_inline_str s pos in - (* FIXME: read TypeRef *) - pos, NCustomMarshaler (guid_val,unmanaged) - | 0x2D -> pos, NError (* 0x2D *) - | i -> pos, NCustom i - -let read_blob_idx ctx s pos = - let metapos,i = if ctx.blob_offset = 2 then - sread_ui16 s pos - else - sread_i32 s pos - in - metapos, i - - -let read_nativesig_idx ctx s pos = - let s = ctx.meta_stream in - let metapos,i = if ctx.blob_offset = 2 then - sread_ui16 s pos - else - sread_i32 s pos - in - let s = ctx.blob_stream in - let _, ret = read_nativesig ctx s i in - metapos, ret - -let read_method_ilsig_idx ctx pos = - let s = ctx.meta_stream in - let metapos,i = if ctx.blob_offset = 2 then - sread_ui16 s pos - else - sread_i32 s pos - in - let s = ctx.blob_stream in - let pos, len = read_compressed_i32 s i in - (* for x = 0 to len do *) - (* printf "%x " (sget s (i+x)) *) - (* done; *) - let endpos = pos + len in - (* printf "\n"; *) - let pos, callconv = read_callconv ctx s pos in - let pos, ntypes = read_compressed_i32 s pos in - let pos, ret = read_ilsig ctx s pos in - let rec loop acc pos n = - if n > ntypes || pos >= endpos then - pos, List.rev acc - else - let pos, ssig = read_ilsig ctx s pos in - loop (ssig :: acc) pos (n+1) - in - let pos, args = loop [] pos 1 in - metapos, SFunPtr (callconv, ret, args) - -let read_ilsig_idx ctx pos = - let s = ctx.meta_stream in - let metapos,i = if ctx.blob_offset = 2 then - sread_ui16 s pos - else - sread_i32 s pos - in - let s = ctx.blob_stream in - let i, _ = read_compressed_i32 s i in - let _, ilsig = read_ilsig ctx s i in - metapos, ilsig - -let read_field_ilsig_idx ?(force_field=true) ctx pos = - let s = ctx.meta_stream in - let metapos,i = if ctx.blob_offset = 2 then - sread_ui16 s pos - else - sread_i32 s pos - in - let s = ctx.blob_stream in - let i, _ = read_compressed_i32 s i in - if sget s i <> 0x6 then - if force_field then - error ("Invalid field signature: " ^ string_of_int (sget s i)) - else - read_method_ilsig_idx ctx pos - else - let _, ilsig = read_ilsig ctx s (i+1) in - metapos, ilsig - -let get_underlying_enum_type ctx name = - (* first try to get a typedef *) - let ns, name = match List.rev (String.nsplit name ".") with - | name :: ns -> List.rev ns, name - | _ -> assert false - in - try - let tdefs = ctx.tables.(int_of_table ITypeDef) in - let len = DynArray.length tdefs in - let rec loop_find idx = - if idx >= len then - raise Not_found - else - let tdef = match DynArray.get tdefs idx with | TypeDef td -> td | _ -> assert false in - if tdef.td_name = name && tdef.td_namespace = ns then - tdef - else - loop_find (idx+1) - in - let tdef = loop_find 1 in - (* now find the first static field associated with it *) - try - let nonstatic = List.find (fun f -> - not (List.mem CStatic f.f_flags.ff_contract) - ) tdef.td_field_list in - nonstatic.f_signature - with | Not_found -> assert false (* should never happen! *) - with | Not_found -> - (* FIXME: in order to correctly handle SEnum, we need to look it up *) - (* from either this assembly or from any other assembly that we reference *) - (* this is tricky - specially since this reader does not intend to handle file system *) - (* operations by itself. For now, if an enum is referenced from another module, *) - (* we won't handle it. The `cache` structure is laid out to deal with these problems *) - (* but isn't implemented yet *) - raise Exit - -let read_custom_attr ctx attr_type s pos = - let pos, prolog = sread_ui16 s pos in - if prolog <> 0x0001 then error (sprintf "Error reading custom attribute: Expected prolog 0x0001 ; got 0x%x" prolog); - let isig = match attr_type with - | Method m -> m.m_signature - | MemberRef mr -> mr.memr_signature - | _ -> assert false - in - let args = match follow isig with - | SFunPtr (_,ret,args) -> args - | _ -> assert false - in - let rec read_instance ilsig pos = - (* print_endline (IlMetaDebug.ilsig_s ilsig); *) - match follow ilsig with - | SBool | SChar | SInt8 | SUInt8 | SInt16 | SUInt16 - | SInt32 | SUInt32 | SInt64 | SUInt64 | SFloat32 | SFloat64 | SString -> - let pos, cons = read_constant ctx (sig_to_const ilsig) s pos in - pos, InstConstant (cons) - | SClass c when is_type (["System"],"Type") c -> - if (sget s pos) == 0xff then - pos+1, InstConstant INull - else - let pos, len = read_compressed_i32 s pos in - pos+len, InstType (String.sub s pos len) - | SType -> - let pos, len = read_compressed_i32 s pos in - pos+len, InstType (String.sub s pos len) - | SObject | SBoxed -> (* boxed *) - let pos = if sget s pos = 0x51 then pos+1 else pos in - let pos, ilsig = read_ilsig ctx s pos in - let pos, ret = read_instance ilsig pos in - pos, InstBoxed( ret ) - (* (match follow ilsig with *) - (* | SEnum e -> *) - (* let ilsig = get_underlying_enum_type ctx e; *) - (* let pos,e = if is_boxed then sread_i32 s pos else read_compressed_i32 s pos in *) - (* pos, InstBoxed(InstEnum e) *) - (* | _ -> *) - (* let pos, boxed = read_constant ctx (sig_to_const ilsig) s pos in *) - (* pos, InstBoxed (InstConstant boxed)) *) - | SEnum e -> - let ilsig = get_underlying_enum_type ctx e in - read_instance ilsig pos - | SValueType _ -> (* enum *) - let pos, e = sread_i32 s pos in - pos, InstEnum e - | _ -> assert false - in - let rec read_fixed acc args pos = match args with - | [] -> - pos, List.rev acc - | SVector isig :: args -> - (* print_endline "vec"; *) - let pos, nelem = sread_real_i32 s pos in - let pos, ret = if nelem = -1l then - pos, InstConstant INull - else - let nelem = Int32.to_int nelem in - let rec loop acc pos n = - if n = nelem then - pos, InstArray (List.rev acc) - else - let pos, inst = read_instance isig pos in - loop (inst :: acc) pos (n+1) - in - loop [] pos 0 - in - read_fixed (ret :: acc) args pos - | isig :: args -> - let pos, i = read_instance isig pos in - read_fixed (i :: acc) args pos - in - (* let tpos = pos in *) - let pos, fixed = read_fixed [] args pos in - (* printf "fixed %d : " (List.length args); *) - (* for x = tpos to pos do *) - (* printf "%x " (sget s x) *) - (* done; *) - (* printf "\n"; *) - (* let len = String.length s - pos - 1 in *) - (* let len = if len > 10 then 10 else len in *) - (* for x = 0 to len do *) - (* printf "%x " (sget s (pos + x)) *) - (* done; *) - (* printf "\n"; *) - let pos, nnamed = read_compressed_i32 s pos in - let pos = if nnamed > 0 then pos+1 else pos in - (* FIXME: this is a hack / quick fix around #3485 . We need to actually read named arguments *) - (* let rec read_named acc pos n = *) - (* if n = nnamed then *) - (* pos, List.rev acc *) - (* else *) - (* let pos, forp = sread_ui8 s pos in *) - (* let is_prop = if forp = 0x53 then *) - (* false *) - (* else if forp = 0x54 then *) - (* true *) - (* else *) - (* error (sprintf "named custom attribute error: expected 0x53 or 0x54 - got 0x%x" forp) *) - (* in *) - (* let pos, t = read_ilsig ctx s pos in *) - (* let pos, len = read_compressed_i32 s pos in *) - (* let name = String.sub s pos len in *) - (* let pos = pos+len in *) - (* let pos, inst = read_instance t pos in *) - (* read_named ( (is_prop, name, inst) :: acc ) pos (n+1) *) - (* in *) - (* let pos, named = read_named [] pos 0 in *) - pos, (fixed, []) - (* pos, (fixed, named) *) - -let read_custom_attr_idx ctx ca attr_type pos = - let s = ctx.meta_stream in - let metapos,i = if ctx.blob_offset = 2 then - sread_ui16 s pos - else - sread_i32 s pos - in - if i = 0 then - metapos - else - let s = ctx.blob_stream in - let i, _ = read_compressed_i32 s i in - ctx.delays <- (fun () -> - try - let _, attr = read_custom_attr ctx attr_type s i in - ca.ca_value <- Some attr - with | Exit -> - () - ) :: ctx.delays; - metapos - -let read_next_index ctx offset table last pos = - if last then - DynArray.length ctx.tables.(int_of_table table) + 1 - else - let s = ctx.meta_stream in - let _, idx = ctx.table_sizes.(int_of_table table) s (pos+offset) in - idx - -let get_rev_list ctx table ptr_table begin_idx end_idx = - (* first check if index exists on pointer table *) - let ptr_table_t = ctx.tables.(int_of_table ptr_table) in - (* printf "table %d begin %d end %d\n" (int_of_table table) begin_idx end_idx; *) - match ctx.compressed, DynArray.length ptr_table_t with - | true, _ | _, 0 -> - (* use direct index *) - let rec loop idx acc = - if idx >= end_idx then - acc - else - loop (idx+1) (get_table ctx table idx :: acc) - in - loop begin_idx [] - | _ -> - (* use indirect index *) - let rec loop idx acc = - if idx > end_idx then - acc - else - loop (idx+1) (get_table ctx ptr_table idx :: acc) - in - let ret = loop begin_idx [] in - List.map (fun meta -> - let p = meta_root_ptr meta in - get_table ctx table p.ptr_to.root_id - ) ret - -let read_list ctx table ptr_table begin_idx offset last pos = - let end_idx = read_next_index ctx offset table last pos in - get_rev_list ctx table ptr_table begin_idx end_idx - -let parse_ns id = match String.nsplit id "." with - | [""] -> [] - | ns -> ns - -let get_meta_pointer = function - | Module r -> IModule, r.md_id - | TypeRef r -> ITypeRef, r.tr_id - | TypeDef r -> ITypeDef, r.td_id - | FieldPtr r -> IFieldPtr, r.fp_id - | Field r -> IField, r.f_id - | MethodPtr r -> IMethodPtr, r.mp_id - | Method r -> IMethod, r.m_id - | ParamPtr r -> IParamPtr, r.pp_id - | Param r -> IParam, r.p_id - | InterfaceImpl r -> IInterfaceImpl, r.ii_id - | MemberRef r -> IMemberRef, r.memr_id - | Constant r -> IConstant, r.c_id - | CustomAttribute r -> ICustomAttribute, r.ca_id - | FieldMarshal r -> IFieldMarshal, r.fm_id - | DeclSecurity r -> IDeclSecurity, r.ds_id - | ClassLayout r -> IClassLayout, r.cl_id - | FieldLayout r -> IFieldLayout, r.fl_id - | StandAloneSig r -> IStandAloneSig, r.sa_id - | EventMap r -> IEventMap, r.em_id - | EventPtr r -> IEventPtr, r.ep_id - | Event r -> IEvent, r.e_id - | PropertyMap r -> IPropertyMap, r.pm_id - | PropertyPtr r -> IPropertyPtr, r.prp_id - | Property r -> IProperty, r.prop_id - | MethodSemantics r -> IMethodSemantics, r.ms_id - | MethodImpl r -> IMethodImpl, r.mi_id - | ModuleRef r -> IModuleRef, r.modr_id - | TypeSpec r -> ITypeSpec, r.ts_id - | ImplMap r -> IImplMap, r.im_id - | FieldRVA r -> IFieldRVA, r.fr_id - | ENCLog r -> IENCLog, r.el_id - | ENCMap r -> IENCMap, r.encm_id - | Assembly r -> IAssembly, r.a_id - | AssemblyProcessor r -> IAssemblyProcessor, r.ap_id - | AssemblyOS r -> IAssemblyOS, r.aos_id - | AssemblyRef r -> IAssemblyRef, r.ar_id - | AssemblyRefProcessor r -> IAssemblyRefProcessor, r.arp_id - | AssemblyRefOS r -> IAssemblyRefOS, r.aros_id - | File r -> IFile, r.file_id - | ExportedType r -> IExportedType, r.et_id - | ManifestResource r -> IManifestResource, r.mr_id - | NestedClass r -> INestedClass, r.nc_id - | GenericParam r -> IGenericParam, r.gp_id - | MethodSpec r -> IMethodSpec, r.mspec_id - | GenericParamConstraint r -> IGenericParamConstraint, r.gc_id - | _ -> assert false - -let add_relation ctx key v = - let ptr = get_meta_pointer key in - Hashtbl.add ctx.relations ptr v - -let read_table_at ctx tbl n last pos = - (* print_endline ("rr " ^ string_of_int (n+1)); *) - let s = ctx.meta_stream in - match get_table ctx tbl (n+1 (* indices start at 1 *)) with - | Module m -> - let pos, gen = sread_ui16 s pos in - let pos, name = read_sstring_idx ctx pos in - let pos, vid = read_sguid_idx ctx pos in - let pos, encid = read_sguid_idx ctx pos in - let pos, encbase_id = read_sguid_idx ctx pos in - m.md_generation <- gen; - m.md_name <- name; - m.md_vid <- vid; - m.md_encid <- encid; - m.md_encbase_id <- encbase_id; - pos, Module m - | TypeRef tr -> - let pos, scope = sread_from_table ctx false IResolutionScope s pos in - let pos, name = read_sstring_idx ctx pos in - let pos, ns = read_sstring_idx ctx pos in - tr.tr_resolution_scope <- scope; - tr.tr_name <- name; - tr.tr_namespace <- parse_ns ns; - (* print_endline name; *) - (* print_endline ns; *) - pos, TypeRef tr - | TypeDef td -> - let startpos = pos in - let pos, flags = sread_i32 s pos in - let pos, name = read_sstring_idx ctx pos in - let pos, ns = read_sstring_idx ctx pos in - let ns = parse_ns ns in - let pos, extends = sread_from_table_opt ctx false ITypeDefOrRef s pos in - let field_offset = pos - startpos in - let pos, flist_begin = ctx.table_sizes.(int_of_table IField) s pos in - let method_offset = pos - startpos in - let pos, mlist_begin = ctx.table_sizes.(int_of_table IMethod) s pos in - td.td_flags <- type_def_flags_of_int flags; - td.td_name <- name; - td.td_namespace <- ns; - td.td_extends <- extends; - td.td_field_list <- List.rev_map get_field (read_list ctx IField IFieldPtr flist_begin field_offset last pos); - td.td_method_list <- List.rev_map get_method (read_list ctx IMethod IMethodPtr mlist_begin method_offset last pos); - List.iter (fun m -> m.m_declaring <- Some td) td.td_method_list; - let path = get_path (TypeDef td) in - Hashtbl.add ctx.typedefs path td; - (* print_endline "Type Def!"; *) - (* print_endline name; *) - (* print_endline ns; *) - pos, TypeDef td - | FieldPtr fp -> - let pos, field = sread_from_table ctx false IField s pos in - let field = get_field field in - fp.fp_field <- field; - pos, FieldPtr fp - | Field f -> - let pos, flags = sread_ui16 s pos in - let pos, name = read_sstring_idx ctx pos in - (* print_endline ("FIELD NAME " ^ name); *) - let pos, ilsig = read_field_ilsig_idx ctx pos in - (* print_endline (ilsig_s ilsig); *) - f.f_flags <- field_flags_of_int flags; - f.f_name <- name; - f.f_signature <- ilsig; - pos, Field f - | MethodPtr mp -> - let pos, m = sread_from_table ctx false IMethod s pos in - let m = get_method m in - mp.mp_method <- m; - pos, MethodPtr mp - | Method m -> - let startpos = pos in - let pos, rva = sread_i32 s pos in - let pos, iflags = sread_ui16 s pos in - let pos, flags = sread_ui16 s pos in - let pos, name = read_sstring_idx ctx pos in - let pos, ilsig = read_method_ilsig_idx ctx pos in - let offset = pos - startpos in - let pos, paramlist = ctx.table_sizes.(int_of_table IParam) s pos in - m.m_rva <- Int32.of_int rva; - m.m_flags <- method_flags_of_int iflags flags; - m.m_name <- name; - m.m_signature <- ilsig; - m.m_param_list <- List.rev_map get_param (read_list ctx IParam IParamPtr paramlist offset last pos); - pos, Method m - | ParamPtr pp -> - let pos, p = sread_from_table ctx false IParam s pos in - let p = get_param p in - pp.pp_param <- p; - pos, ParamPtr pp - | Param p -> - let pos, flags = sread_ui16 s pos in - let pos, sequence = sread_ui16 s pos in - let pos, name = read_sstring_idx ctx pos in - p.p_flags <- param_flags_of_int flags; - p.p_sequence <- sequence; - p.p_name <- name; - pos, Param p - | InterfaceImpl ii -> - let pos, cls = sread_from_table ctx false ITypeDef s pos in - add_relation ctx cls (InterfaceImpl ii); - let cls = get_type_def cls in - let pos, interface = sread_from_table ctx false ITypeDefOrRef s pos in - ii.ii_class <- cls; - ii.ii_interface <- interface; - pos, InterfaceImpl ii - | MemberRef mr -> - let pos, cls = sread_from_table ctx false IMemberRefParent s pos in - let pos, name = read_sstring_idx ctx pos in - (* print_endline name; *) - (* let pos, signature = read_ilsig_idx ctx pos in *) - let pos, signature = read_field_ilsig_idx ~force_field:false ctx pos in - (* print_endline (ilsig_s signature); *) - mr.memr_class <- cls; - mr.memr_name <- name; - mr.memr_signature <- signature; - add_relation ctx cls (MemberRef mr); - pos, MemberRef mr - | Constant c -> - let pos, ctype = read_constant_type ctx s pos in - let pos = pos+1 in - let pos, parent = sread_from_table ctx false IHasConstant s pos in - let pos, blobpos = if ctx.blob_offset = 2 then - sread_ui16 s pos - else - sread_i32 s pos - in - let blob = ctx.blob_stream in - let blobpos, _ = read_compressed_i32 blob blobpos in - let _, value = read_constant ctx ctype blob blobpos in - c.c_type <- ctype; - c.c_parent <- parent; - c.c_value <- value; - add_relation ctx parent (Constant c); - pos, Constant c - | CustomAttribute ca -> - let pos, parent = sread_from_table ctx false IHasCustomAttribute s pos in - let pos, t = sread_from_table ctx false ICustomAttributeType s pos in - let pos = read_custom_attr_idx ctx ca t pos in - ca.ca_parent <- parent; - ca.ca_type <- t; - ca.ca_value <- None; (* this will be delayed by read_custom_attr_idx *) - add_relation ctx parent (CustomAttribute ca); - pos, CustomAttribute ca - | FieldMarshal fm -> - let pos, parent = sread_from_table ctx false IHasFieldMarshal s pos in - let pos, nativesig = read_nativesig_idx ctx s pos in - fm.fm_parent <- parent; - fm.fm_native_type <- nativesig; - add_relation ctx parent (FieldMarshal fm); - pos, FieldMarshal fm - | DeclSecurity ds -> - let pos, action = sread_ui16 s pos in - let action = action_security_of_int action in - let pos, parent = sread_from_table ctx false IHasDeclSecurity s pos in - let pos, permission_set = read_sblob_idx ctx pos in - ds.ds_action <- action; - ds.ds_parent <- parent; - ds.ds_permission_set <- permission_set; - add_relation ctx parent (DeclSecurity ds); - pos, DeclSecurity ds - | ClassLayout cl -> - let pos, psize = sread_ui16 s pos in - let pos, csize = sread_i32 s pos in - let pos, parent = sread_from_table ctx false ITypeDef s pos in - add_relation ctx parent (ClassLayout cl); - let parent = get_type_def parent in - cl.cl_packing_size <- psize; - cl.cl_class_size <- csize; - cl.cl_parent <- parent; - pos, ClassLayout cl - | FieldLayout fl -> - let pos, offset = sread_i32 s pos in - let pos, field = sread_from_table ctx false IField s pos in - fl.fl_offset <- offset; - fl.fl_field <- get_field field; - add_relation ctx field (FieldLayout fl); - pos, FieldLayout fl - | StandAloneSig sa -> - let pos, ilsig = read_field_ilsig_idx ~force_field:false ctx pos in - (* print_endline (ilsig_s ilsig); *) - sa.sa_signature <- ilsig; - pos, StandAloneSig sa - | EventMap em -> - let startpos = pos in - let pos, parent = sread_from_table ctx false ITypeDef s pos in - let offset = pos - startpos in - let pos, event_list = ctx.table_sizes.(int_of_table IEvent) s pos in - em.em_parent <- get_type_def parent; - em.em_event_list <- List.rev_map get_event (read_list ctx IEvent IEventPtr event_list offset last pos); - add_relation ctx parent (EventMap em); - pos, EventMap em - | EventPtr ep -> - let pos, event = sread_from_table ctx false IEvent s pos in - ep.ep_event <- get_event event; - pos, EventPtr ep - | Event e -> - let pos, flags = sread_ui16 s pos in - let pos, name = read_sstring_idx ctx pos in - let pos, event_type = sread_from_table ctx false ITypeDefOrRef s pos in - e.e_flags <- event_flags_of_int flags; - e.e_name <- name; - (* print_endline name; *) - e.e_event_type <- event_type; - add_relation ctx event_type (Event e); - pos, Event e - | PropertyMap pm -> - let startpos = pos in - let pos, parent = sread_from_table ctx false ITypeDef s pos in - let offset = pos - startpos in - let pos, property_list = ctx.table_sizes.(int_of_table IProperty) s pos in - pm.pm_parent <- get_type_def parent; - pm.pm_property_list <- List.rev_map get_property (read_list ctx IProperty IPropertyPtr property_list offset last pos); - add_relation ctx parent (PropertyMap pm); - pos, PropertyMap pm - | PropertyPtr pp -> - let pos, property = sread_from_table ctx false IProperty s pos in - pp.prp_property <- get_property property; - pos, PropertyPtr pp - | Property prop -> - let pos, flags = sread_ui16 s pos in - let pos, name = read_sstring_idx ctx pos in - let pos, t = read_field_ilsig_idx ~force_field:false ctx pos in - prop.prop_flags <- property_flags_of_int flags; - prop.prop_name <- name; - (* print_endline name; *) - prop.prop_type <- t; - (* print_endline (ilsig_s t); *) - pos, Property prop - | MethodSemantics ms -> - let pos, semantic = sread_ui16 s pos in - let pos, m = sread_from_table ctx false IMethod s pos in - let pos, association = sread_from_table ctx false IHasSemantics s pos in - ms.ms_semantic <- semantic_flags_of_int semantic; - ms.ms_method <- get_method m; - ms.ms_association <- association; - add_relation ctx m (MethodSemantics ms); - add_relation ctx association (MethodSemantics ms); - pos, MethodSemantics ms - | MethodImpl mi -> - let pos, cls = sread_from_table ctx false ITypeDef s pos in - let pos, method_body = sread_from_table ctx false IMethodDefOrRef s pos in - let pos, method_declaration = sread_from_table ctx false IMethodDefOrRef s pos in - mi.mi_class <- get_type_def cls; - mi.mi_method_body <- method_body; - mi.mi_method_declaration <- method_declaration; - add_relation ctx method_body (MethodImpl mi); - pos, MethodImpl mi - | ModuleRef modr -> - let pos, name = read_sstring_idx ctx pos in - modr.modr_name <- name; - (* print_endline name; *) - pos, ModuleRef modr - | TypeSpec ts -> - let pos, signature = read_ilsig_idx ctx pos in - (* print_endline (ilsig_s signature); *) - ts.ts_signature <- signature; - pos, TypeSpec ts - | ENCLog el -> - let pos, token = sread_i32 s pos in - let pos, func_code = sread_i32 s pos in - el.el_token <- token; - el.el_func_code <- func_code; - pos, ENCLog el - | ImplMap im -> - let pos, flags = sread_ui16 s pos in - let pos, forwarded = sread_from_table ctx false IMemberForwarded s pos in - let pos, import_name = read_sstring_idx ctx pos in - let pos, import_scope = sread_from_table ctx false IModuleRef s pos in - im.im_flags <- impl_flags_of_int flags; - im.im_forwarded <- forwarded; - im.im_import_name <- import_name; - im.im_import_scope <- get_module_ref import_scope; - add_relation ctx forwarded (ImplMap im); - pos, ImplMap im - | ENCMap em -> - let pos, token = sread_i32 s pos in - em.encm_token <- token; - pos, ENCMap em - | FieldRVA f -> - let pos, rva = sread_real_i32 s pos in - let pos, field = sread_from_table ctx false IField s pos in - f.fr_rva <- rva; - f.fr_field <- get_field field; - add_relation ctx field (FieldRVA f); - pos, FieldRVA f - | Assembly a -> - let pos, hash_algo = sread_i32 s pos in - let pos, major = sread_ui16 s pos in - let pos, minor = sread_ui16 s pos in - let pos, build = sread_ui16 s pos in - let pos, rev = sread_ui16 s pos in - let pos, flags = sread_i32 s pos in - let pos, public_key = read_sblob_idx ctx pos in - let pos, name = read_sstring_idx ctx pos in - let pos, locale = read_sstring_idx ctx pos in - a.a_hash_algo <- hash_algo_of_int hash_algo; - a.a_major <- major; - a.a_minor <- minor; - a.a_build <- build; - a.a_rev <- rev; - a.a_flags <- assembly_flags_of_int flags; - a.a_public_key <- public_key; - a.a_name <- name; - a.a_locale <- locale; - pos, Assembly a - | AssemblyProcessor ap -> - let pos, processor = sread_i32 s pos in - ap.ap_processor <- processor; - pos, AssemblyProcessor ap - | AssemblyOS aos -> - let pos, platform_id = sread_i32 s pos in - let pos, major = sread_i32 s pos in - let pos, minor = sread_i32 s pos in - aos.aos_platform_id <- platform_id; - aos.aos_major_version <- major; - aos.aos_minor_version <- minor; - pos, AssemblyOS aos - | AssemblyRef ar -> - let pos, major = sread_ui16 s pos in - let pos, minor = sread_ui16 s pos in - let pos, build = sread_ui16 s pos in - let pos, rev = sread_ui16 s pos in - let pos, flags = sread_i32 s pos in - let pos, public_key = read_sblob_idx ctx pos in - let pos, name = read_sstring_idx ctx pos in - let pos, locale = read_sstring_idx ctx pos in - let pos, hash_value = read_sblob_idx ctx pos in - ar.ar_major <- major; - ar.ar_minor <- minor; - ar.ar_build <- build; - ar.ar_rev <- rev; - ar.ar_flags <- assembly_flags_of_int flags; - ar.ar_public_key <- public_key; - ar.ar_name <- name; - (* print_endline name; *) - ar.ar_locale <- locale; - (* print_endline locale; *) - ar.ar_hash_value <- hash_value; - pos, AssemblyRef ar - | AssemblyRefProcessor arp -> - let pos, processor = sread_i32 s pos in - let pos, assembly_ref = sread_from_table ctx false IAssemblyRef s pos in - arp.arp_processor <- processor; - arp.arp_assembly_ref <- get_assembly_ref assembly_ref; - pos, AssemblyRefProcessor arp - | AssemblyRefOS aros -> - let pos, platform_id = sread_i32 s pos in - let pos, major = sread_i32 s pos in - let pos, minor = sread_i32 s pos in - let pos, assembly_ref = sread_from_table ctx false IAssemblyRef s pos in - aros.aros_platform_id <- platform_id; - aros.aros_major <- major; - aros.aros_minor <- minor; - aros.aros_assembly_ref <- get_assembly_ref assembly_ref; - pos, AssemblyRefOS aros - | File file -> - let pos, flags = sread_i32 s pos in - let pos, name = read_sstring_idx ctx pos in - let pos, hash_value = read_sblob_idx ctx pos in - file.file_flags <- file_flag_of_int flags; - file.file_name <- name; - (* print_endline ("file " ^ name); *) - file.file_hash_value <- hash_value; - pos, File file - | ExportedType et -> - let pos, flags = sread_i32 s pos in - let pos, type_def_id = sread_i32 s pos in - let pos, type_name = read_sstring_idx ctx pos in - let pos, type_namespace = read_sstring_idx ctx pos in - let pos, impl = sread_from_table ctx false IImplementation s pos in - et.et_flags <- type_def_flags_of_int flags; - et.et_type_def_id <- type_def_id; - et.et_type_name <- type_name; - et.et_type_namespace <- parse_ns type_namespace; - et.et_implementation <- impl; - add_relation ctx impl (ExportedType et); - pos, ExportedType et - | ManifestResource mr -> - let pos, offset = sread_i32 s pos in - let pos, flags = sread_i32 s pos in - (* printf "offset 0x%x flags 0x%x\n" offset flags; *) - let pos, name = read_sstring_idx ctx pos in - let rpos, i = ctx.table_sizes.(int_of_table IImplementation) s pos in - let pos, impl = - if i = 0 then - rpos, None - else - let pos, ret = sread_from_table ctx false IImplementation s pos in - add_relation ctx ret (ManifestResource mr); - pos, Some ret - in - mr.mr_offset <- offset; - mr.mr_flags <- manifest_resource_flag_of_int flags; - mr.mr_name <- name; - mr.mr_implementation <- impl; - pos, ManifestResource mr - | NestedClass nc -> - let pos, nested = sread_from_table ctx false ITypeDef s pos in - let pos, enclosing = sread_from_table ctx false ITypeDef s pos in - nc.nc_nested <- get_type_def nested; - nc.nc_enclosing <- get_type_def enclosing; - - assert (nc.nc_nested.td_extra_enclosing = None); - nc.nc_nested.td_extra_enclosing <- Some nc.nc_enclosing; - add_relation ctx enclosing (NestedClass nc); - pos, NestedClass nc - | GenericParam gp -> - let pos, number = sread_ui16 s pos in - let pos, flags = sread_ui16 s pos in - let pos, owner = sread_from_table ctx false ITypeOrMethodDef s pos in - let spos, nidx = - if ctx.strings_offset = 2 then - sread_ui16 s pos - else - sread_i32 s pos - in - let pos, name = - if nidx = 0 then - spos, None - else - let pos, ret = read_sstring_idx ctx pos in - (* print_endline ret; *) - pos, Some ret - in - gp.gp_number <- number; - gp.gp_flags <- generic_flags_of_int flags; - gp.gp_owner <- owner; - gp.gp_name <- name; - add_relation ctx owner (GenericParam gp); - pos, GenericParam gp - | MethodSpec mspec -> - let pos, meth = sread_from_table ctx false IMethodDefOrRef s pos in - let pos, instantiation = read_method_ilsig_idx ctx pos in - (* print_endline (ilsig_s instantiation); *) - mspec.mspec_method <- meth; - mspec.mspec_instantiation <- instantiation; - add_relation ctx meth (MethodSpec mspec); - pos, MethodSpec mspec - | GenericParamConstraint gc -> - let pos, owner = sread_from_table ctx false IGenericParam s pos in - let pos, c = sread_from_table ctx false ITypeDefOrRef s pos in - gc.gc_owner <- get_generic_param owner; - gc.gc_constraint <- c; - add_relation ctx owner (GenericParamConstraint gc); - pos, GenericParamConstraint gc - | _ -> assert false - -(* ******* META READING ********* *) - -let preset_sizes ctx rows = - Array.iteri (fun n r -> match r with - | false,_ -> () - | true,nrows -> - (* printf "table %d nrows %d\n" n nrows; *) - let tbl = table_of_int n in - ctx.tables.(n) <- DynArray.init (nrows) (fun id -> mk_meta tbl (id+1)) - ) rows - -(* let read_ *) -let read_meta ctx = - (* read header *) - let s = ctx.meta_stream in - let pos = 4 + 1 + 1 in - let flags = sget s pos in - List.iter (fun i -> if flags land i = i then match i with - | 0x01 -> - ctx.strings_offset <- 4 - | 0x02 -> - ctx.guid_offset <- 4 - | 0x04 -> - ctx.blob_offset <- 4 - | 0x20 -> - assert (not ctx.compressed); - ctx.meta_edit_continue <- true - | 0x80 -> - assert (not ctx.compressed); - ctx.meta_has_deleted <- true - | _ -> assert false - ) [0x01;0x02;0x04;0x20;0x80]; - let rid = sget s (pos+1) in - ignore rid; - let pos = pos + 2 in - let mask = Array.init 8 ( fun n -> sget s (pos + n) ) in - (* loop over masks and check which table is set *) - let set_table = Array.init 64 (fun n -> - let idx = n / 8 in - let bit = n mod 8 in - (mask.(idx) lsr bit) land 0x1 = 0x1 - ) in - let pos = ref (pos + 8 + 8) in (* there is an extra 'sorted' field, which we do not use *) - let rows = Array.mapi (fun i b -> match b with - | false -> false,0 - | true -> - let nidx, nrows = sread_i32 s !pos in - if nrows > 0xFFFF then ctx.table_sizes.(i) <- sread_i32; - pos := nidx; - true,nrows - ) set_table in - set_coded_sizes ctx rows; - (* pre-set all sizes *) - preset_sizes ctx rows; - Array.iteri (fun n r -> match r with - | false,_ -> () - | true,nrows -> - (* print_endline (string_of_int n); *) - let fn = read_table_at ctx (table_of_int n) in - let rec loop_fn n = - if n = nrows then - () - else begin - let p, _ = fn n (n = (nrows-1)) !pos in - pos := p; - loop_fn (n+1) - end - in - loop_fn 0 - ) rows; - () - -let read_padded i npad = - let buf = Buffer.create 10 in - let rec loop n = - let chr = read i in - if chr = '\x00' then begin - let npad = n land 0x3 in - if npad <> 0 then ignore (nread i (4 - npad)); - Buffer.contents buf - end else begin - Buffer.add_char buf chr; - if n = npad then - Buffer.contents buf - else - loop (n+1) - end - in - loop 1 - -let read_meta_tables pctx header module_cache = - let i = pctx.r.i in - seek_rva pctx (fst header.clr_meta); - let magic = nread_string i 4 in - if magic <> "BSJB" then error ("Error reading metadata table: Expected magic 'BSJB'. Got " ^ magic); - let major = read_ui16 i in - let minor = read_ui16 i in - ignore major; ignore minor; (* no use for them *) - ignore (read_i32 i); (* reserved *) - let vlen = read_i32 i in - let ver = nread i vlen in - ignore ver; - - (* meta storage header *) - ignore (read_ui16 i); (* reserved *) - let nstreams = read_ui16 i in - let rec streams n acc = - let offset = read_i32 i in - let size = read_real_i32 i in - let name = read_padded i 32 in - let acc = { - str_offset = offset; - str_size = size; - str_name = name; - } :: acc in - if (n+1) = nstreams then - acc - else - streams (n+1) acc - in - let streams = streams 0 [] in - - (* streams *) - let compressed = ref None in - let sstrings = ref "" in - let sblob = ref "" in - let sguid = ref "" in - let sus = ref "" in - let smeta = ref "" in - let extra = ref [] in - List.iter (fun s -> - let rva = Int32.add (fst header.clr_meta) (Int32.of_int s.str_offset) in - seek_rva pctx rva; - match String.lowercase s.str_name with - | "#guid" -> - sguid := nread_string i (Int32.to_int s.str_size) - | "#strings" -> - sstrings := nread_string i (Int32.to_int s.str_size) - | "#us" -> - sus := nread_string i (Int32.to_int s.str_size) - | "#blob" -> - sblob := nread_string i (Int32.to_int s.str_size) - | "#~" -> - assert (Option.is_none !compressed); - compressed := Some true; - smeta := nread_string i (Int32.to_int s.str_size) - | "#-" -> - assert (Option.is_none !compressed); - compressed := Some false; - smeta := nread_string i (Int32.to_int s.str_size) - | _ -> - extra := s :: !extra - ) streams; - let compressed = match !compressed with - | None -> error "No compressed or uncompressed metadata streams was found!" - | Some c -> c - in - let tables = Array.init 64 (fun _ -> DynArray.create ()) in - let ctx = { - compressed = compressed; - strings_stream = !sstrings; - strings_offset = 2; - blob_stream = !sblob; - blob_offset = 2; - guid_stream = !sguid; - guid_offset = 2; - us_stream = !sus; - meta_stream = !smeta; - meta_edit_continue = false; - meta_has_deleted = false; - - module_cache = module_cache; - extra_streams = !extra; - relations = Hashtbl.create 64; - typedefs = Hashtbl.create 64; - tables = tables; - table_sizes = Array.make (max_clr_meta_idx+1) sread_ui16; - - delays = []; - } in - read_meta ctx; - let delays = ctx.delays in - ctx.delays <- []; - List.iter (fun fn -> fn()) delays; - assert (ctx.delays = []); - { - il_tables = ctx.tables; - il_relations = ctx.relations; - il_typedefs = ctx.typedefs; - } - diff --git a/libs/ilib/ilMetaTools.ml b/libs/ilib/ilMetaTools.ml deleted file mode 100644 index 5630e99bb0e..00000000000 --- a/libs/ilib/ilMetaTools.ml +++ /dev/null @@ -1,472 +0,0 @@ -(* - * This file is part of ilLib - * Copyright (c)2004-2013 Haxe Foundation - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA - *) -open IlMeta;; -open IlData;; -open PeReader;; -open ExtString;; - -let rec follow s = match s with - | SReqModifier (_,s) - | SOptModifier (_,s) -> - follow s - | SPinned s -> - follow s - | s -> s - -(* tells if a type_def_or_ref is of type `path` *) -let rec is_type path = function - | TypeDef td -> - td.td_namespace = fst path && td.td_name = snd path - | TypeRef tr -> - tr.tr_namespace = fst path && tr.tr_name = snd path - | TypeSpec ts -> (match follow ts.ts_signature with - | SClass c | SValueType c -> - is_type path c - | SGenericInst(s,_) -> (match follow s with - | SClass c | SValueType c -> - is_type path c - | _ -> false) - | _ -> false) - | _ -> assert false - -let rec get_path type_def_or_ref = match type_def_or_ref with - | TypeDef td -> (match td.td_extra_enclosing with - | None -> - td.td_namespace,[], td.td_name - | Some t2 -> - let ns, nested = match get_path (TypeDef t2) with - | ns,nested, name -> - ns, nested @ [name] - in - ns,nested, td.td_name) - | TypeRef tr -> (match tr.tr_resolution_scope with - | TypeRef tr2 -> - let ns, nested = match get_path (TypeRef tr2) with - | ns,nested, name -> - ns, nested @ [name] - in - ns,nested, tr.tr_name - | _ -> - tr.tr_namespace,[],tr.tr_name) - | TypeSpec ts -> (match follow ts.ts_signature with - | SClass c | SValueType c -> - get_path c - | SGenericInst(s,_) -> (match follow s with - | SClass c | SValueType c -> - get_path c - | _ -> [],[],"") - | _ -> [],[],"") - | _ -> assert false - -let constant_s = function - | IBool true -> "true" - | IBool false -> "false" - | IChar chr -> "'" ^ Char.escaped (Char.chr chr) ^ "'" - | IByte i -> - Printf.sprintf "(byte) 0x%x" i - | IShort i -> - Printf.sprintf "(short) 0x%x" i - | IInt i -> - Printf.sprintf "0x%lx" i - | IInt64 i -> - Printf.sprintf "0x%Lx" i - | IFloat32 f -> - Printf.sprintf "%ff" f - | IFloat64 f -> - Printf.sprintf "%fd" f - | IString s -> "\"" ^ s ^ "\"" - | INull -> "null" - -let path_s = function - | [],[], s -> s - | ns,[], s -> String.concat "." ns ^ "." ^ s - | [],enc, s -> String.concat "@" enc ^ "." ^ s - | ns,enc,s -> String.concat "." ns ^ "." ^ String.concat "@" enc ^ "." ^ s - -let rec ilsig_s = function - | SBoxed -> "boxed" - | SEnum e -> "enum " ^ e - | SType -> "System.Type" - | SVoid -> "void" - | SBool -> "bool" - | SChar -> "char" - | SInt8 -> "int8" - | SUInt8 -> "uint8" - | SInt16 -> "int16" - | SUInt16 -> "uint16" - | SInt32 -> "int32" - | SUInt32 -> "uint32" - | SInt64 -> "int64" - | SUInt64 -> "uint64" - | SFloat32 -> "float" - | SFloat64 -> "double" - | SString -> "string" - | SPointer s -> ilsig_s s ^ "*" - | SManagedPointer s -> ilsig_s s ^ "&" - | SValueType td -> "valuetype " ^ path_s (get_path td) - | SClass cl -> "classtype " ^ path_s (get_path cl) - | STypeParam t | SMethodTypeParam t -> "!" ^ string_of_int t - | SArray (s,opts) -> - ilsig_s s ^ "[" ^ String.concat "," (List.map (function - | Some i,None when i <> 0 -> - string_of_int i ^ "..." - | None, Some i when i <> 0 -> - string_of_int i - | Some s, Some b when b = 0 && s <> 0 -> - string_of_int s ^ "..." - | Some s, Some b when s <> 0 || b <> 0 -> - let b = if b > 0 then b - 1 else b in - string_of_int s ^ "..." ^ string_of_int (s + b) - | _ -> - "" - ) (Array.to_list opts)) ^ "]" - | SGenericInst (t,tl) -> - "generic " ^ (ilsig_s t) ^ "<" ^ String.concat ", " (List.map ilsig_s tl) ^ ">" - | STypedReference -> "typedreference" - | SIntPtr -> "native int" - | SUIntPtr -> "native unsigned int" - | SFunPtr (callconv,ret,args) -> - "function " ^ ilsig_s ret ^ "(" ^ String.concat ", " (List.map ilsig_s args) ^ ")" - | SObject -> "object" - | SVector s -> ilsig_s s ^ "[]" - | SReqModifier (_,s) -> "modreq() " ^ ilsig_s s - | SOptModifier (_,s) -> "modopt() " ^ ilsig_s s - | SSentinel -> "..." - | SPinned s -> "pinned " ^ ilsig_s s - -let rec instance_s = function - | InstConstant c -> constant_s c - | InstBoxed b -> "boxed " ^ instance_s b - | InstType t -> "Type " ^ t - | InstArray il -> "[" ^ String.concat ", " (List.map instance_s il) ^ "]" - | InstEnum e -> "Enum " ^ string_of_int e - -let named_attribute_s (is_prop,name,inst) = - (if is_prop then - "/*prop*/ " - else - "") - ^ name ^ " = " ^ instance_s inst - -let attributes_s (il,nal) = - "(" ^ (String.concat ", " (List.map instance_s il)) ^ (if nal <> [] then ", " ^ (String.concat ", " (List.map named_attribute_s nal)) else "") ^")" - -let meta_root m : meta_root = match m with - | Module r -> Obj.magic r - | TypeRef r -> Obj.magic r - | TypeDef r -> Obj.magic r - | FieldPtr r -> Obj.magic r - | Field r -> Obj.magic r - | MethodPtr r -> Obj.magic r - | Method r -> Obj.magic r - | ParamPtr r -> Obj.magic r - | Param r -> Obj.magic r - | InterfaceImpl r -> Obj.magic r - | MemberRef r -> Obj.magic r - | Constant r -> Obj.magic r - | CustomAttribute r -> Obj.magic r - | FieldMarshal r -> Obj.magic r - | DeclSecurity r -> Obj.magic r - | ClassLayout r -> Obj.magic r - | FieldLayout r -> Obj.magic r - | StandAloneSig r -> Obj.magic r - | EventMap r -> Obj.magic r - | EventPtr r -> Obj.magic r - | Event r -> Obj.magic r - | PropertyMap r -> Obj.magic r - | PropertyPtr r -> Obj.magic r - | Property r -> Obj.magic r - | MethodSemantics r -> Obj.magic r - | MethodImpl r -> Obj.magic r - | ModuleRef r -> Obj.magic r - | TypeSpec r -> Obj.magic r - | ImplMap r -> Obj.magic r - | FieldRVA r -> Obj.magic r - | ENCLog r -> Obj.magic r - | ENCMap r -> Obj.magic r - | Assembly r -> Obj.magic r - | AssemblyProcessor r -> Obj.magic r - | AssemblyOS r -> Obj.magic r - | AssemblyRef r -> Obj.magic r - | AssemblyRefProcessor r -> Obj.magic r - | AssemblyRefOS r -> Obj.magic r - | File r -> Obj.magic r - | ExportedType r -> Obj.magic r - | ManifestResource r -> Obj.magic r - | NestedClass r -> Obj.magic r - | GenericParam r -> Obj.magic r - | MethodSpec r -> Obj.magic r - | GenericParamConstraint r -> Obj.magic r - | _ -> assert false - -let meta_root_ptr p : meta_root_ptr = match p with - | FieldPtr r -> Obj.magic r - | MethodPtr r -> Obj.magic r - | ParamPtr r -> Obj.magic r - | EventPtr r -> Obj.magic r - | _ -> assert false - -let rec ilsig_norm = function - | SVoid -> LVoid - | SBool -> LBool - | SChar -> LChar - | SInt8 -> LInt8 - | SUInt8 -> LUInt8 - | SInt16 -> LInt16 - | SUInt16 -> LUInt16 - | SInt32 -> LInt32 - | SUInt32 -> LUInt32 - | SInt64 -> LInt64 - | SUInt64 -> LUInt64 - | SFloat32 -> LFloat32 - | SFloat64 -> LFloat64 - | SString -> LString - | SPointer p -> LPointer (ilsig_norm p) - | SManagedPointer p -> LManagedPointer (ilsig_norm p) - | SValueType v -> LValueType (get_path v, []) - | SClass v -> LClass (get_path v, []) - | STypeParam i -> LTypeParam i - | SArray (t, opts) -> LArray(ilsig_norm t, opts) - | SGenericInst (p,args) -> (match follow p with - | SClass v -> - LClass(get_path v, List.map ilsig_norm args) - | SValueType v -> - LValueType(get_path v, List.map ilsig_norm args) - | _ -> assert false) - | STypedReference -> LTypedReference - | SIntPtr -> LIntPtr - | SUIntPtr -> LUIntPtr - | SFunPtr(conv,ret,args) -> LMethod(conv,ilsig_norm ret,List.map ilsig_norm args) - | SObject -> LObject - | SVector s -> LVector (ilsig_norm s) - | SMethodTypeParam i -> LMethodTypeParam i - | SReqModifier (_,s) -> ilsig_norm s - | SOptModifier (_,s) -> ilsig_norm s - | SSentinel -> LSentinel - | SPinned s -> ilsig_norm s - | SType -> LClass( (["System"],[],"Type"), []) - | SBoxed -> LObject - | SEnum e -> - let lst = String.nsplit e "." in - let rev = List.rev lst in - match rev with - | hd :: tl -> LValueType( (List.rev tl,[],hd), [] ) - | _ -> assert false - -let ilsig_t s = - { - snorm = ilsig_norm s; - ssig = s; - } - -let ilsig_of_tdef_ref = function - | TypeDef td -> - SClass (TypeDef td) - | TypeRef tr -> - SClass (TypeRef tr) - | TypeSpec ts -> - ts.ts_signature - | s -> - (* error ("Invalid tdef_or_ref: " ^ ilsig_s s) *) - error "Invalid tdef_or_ref" - -let convert_field ctx f = - let constant = List.fold_left (fun c -> function - | Constant c -> - Some c.c_value - | _ -> - c - ) None (Hashtbl.find_all ctx.il_relations (IField, f.f_id)) - in - { - fname = f.f_name; - fflags = f.f_flags; - fsig = ilsig_t f.f_signature; - fconstant = constant; - } - -let convert_generic ctx gp = - let constraints = List.fold_left (fun c -> function - | GenericParamConstraint gc -> - ilsig_t (ilsig_of_tdef_ref gc.gc_constraint) :: c - | _ -> - c - ) [] (Hashtbl.find_all ctx.il_relations (IGenericParam, gp.gp_id)) - in - { - tnumber = gp.gp_number; - tflags = gp.gp_flags; - tname = gp.gp_name; - tconstraints = constraints; - } - -let convert_method ctx m = - let msig = ilsig_t m.m_signature in - let ret, margs = match follow msig.ssig with - | SFunPtr (_,ret,args) -> - (* print_endline m.m_name; *) - (* print_endline (Printf.sprintf "%d vs %d" (List.length args) (List.length m.m_param_list)); *) - (* print_endline (String.concat ", " (List.map (fun p ->string_of_int p.p_sequence ^ ":" ^ p.p_name) m.m_param_list)); *) - (* print_endline (String.concat ", " (List.map (ilsig_s) args)); *) - (* print_endline "\n"; *) - (* TODO: find out WHY this happens *) - let param_list = List.filter (fun p -> p.p_sequence > 0) m.m_param_list in - if List.length param_list <> List.length args then - let i = ref 0 in - ilsig_t ret, List.map (fun s -> - incr i; "arg" ^ (string_of_int !i), { pf_io = []; pf_reserved = [] }, ilsig_t s) args - else - ilsig_t ret, List.map2 (fun p s -> - p.p_name, p.p_flags, ilsig_t s - ) param_list args - | _ -> assert false - in - - let override, types, semantics = - List.fold_left (fun (override,types,semantics) -> function - | MethodImpl mi -> - let declaring = match mi.mi_method_declaration with - | MemberRef mr -> - Some (get_path mr.memr_class, mr.memr_name) - | Method m -> (match m.m_declaring with - | Some td -> - Some (get_path (TypeDef td), m.m_name) - | None -> override) - | _ -> override - in - declaring, types, semantics - | GenericParam gp -> - override, (convert_generic ctx gp) :: types, semantics - | MethodSemantics ms -> - override, types, ms.ms_semantic @ semantics - | _ -> - override,types, semantics - ) (None,[],[]) (Hashtbl.find_all ctx.il_relations (IMethod, m.m_id)) - in - { - mname = m.m_name; - mflags = m.m_flags; - msig = msig; - margs = margs; - mret = ret; - moverride = override; - mtypes = types; - msemantics = semantics; - } - -let convert_prop ctx prop = - let name = prop.prop_name in - let flags = prop.prop_flags in - let psig = ilsig_t prop.prop_type in - let pget, pset = - List.fold_left (fun (get,set) -> function - | MethodSemantics ms when List.mem SGetter ms.ms_semantic -> - assert (get = None); - Some (ms.ms_method.m_name, ms.ms_method.m_flags), set - | MethodSemantics ms when List.mem SSetter ms.ms_semantic -> - assert (set = None); - get, Some (ms.ms_method.m_name,ms.ms_method.m_flags) - | _ -> get,set - ) - (None,None) - (Hashtbl.find_all ctx.il_relations (IProperty, prop.prop_id)) - in - { - pname = name; - psig = psig; - pflags = flags; - pget = pget; - pset = pset; - } - -let convert_event ctx event = - let name = event.e_name in - let flags = event.e_flags in - let esig = ilsig_of_tdef_ref event.e_event_type in - let esig = ilsig_t esig in - let add, remove, eraise = - List.fold_left (fun (add, remove, eraise) -> function - | MethodSemantics ms when List.mem SAddOn ms.ms_semantic -> - assert (add = None); - Some (ms.ms_method.m_name, ms.ms_method.m_flags), remove, eraise - | MethodSemantics ms when List.mem SRemoveOn ms.ms_semantic -> - assert (remove = None); - add, Some (ms.ms_method.m_name,ms.ms_method.m_flags), eraise - | MethodSemantics ms when List.mem SFire ms.ms_semantic -> - assert (eraise = None); - add, remove, Some (ms.ms_method.m_name, ms.ms_method.m_flags) - | _ -> add, remove, eraise - ) - (None,None,None) - (Hashtbl.find_all ctx.il_relations (IEvent, event.e_id)) - in - { - ename = name; - eflags = flags; - esig = esig; - eadd = add; - eremove = remove; - eraise = eraise; - } - -let convert_class ctx path = - let td = Hashtbl.find ctx.il_typedefs path in - let cpath = get_path (TypeDef td) in - let cflags = td.td_flags in - let csuper = Option.map (fun e -> ilsig_t (ilsig_of_tdef_ref e)) td.td_extends in - let cfields = List.map (convert_field ctx) td.td_field_list in - let cmethods = List.map (convert_method ctx) td.td_method_list in - let enclosing = Option.map (fun t -> get_path (TypeDef t)) td.td_extra_enclosing in - let impl, types, nested, props, events, attrs = - List.fold_left (fun (impl,types,nested,props,events,attrs) -> function - | InterfaceImpl ii -> - (ilsig_t (ilsig_of_tdef_ref ii.ii_interface)) :: impl,types,nested, props, events, attrs - | GenericParam gp -> - (impl, (convert_generic ctx gp) :: types, nested, props,events, attrs) - | NestedClass nc -> - assert (nc.nc_enclosing.td_id = td.td_id); - (impl,types,(get_path (TypeDef nc.nc_nested)) :: nested, props, events, attrs) - | PropertyMap pm -> - assert (props = []); - impl,types,nested,List.map (convert_prop ctx) pm.pm_property_list, events, attrs - | EventMap em -> - assert (events = []); - (impl,types,nested,props,List.map (convert_event ctx) em.em_event_list, attrs) - | CustomAttribute a -> - impl,types,nested,props,events,(a :: attrs) - | _ -> - (impl,types,nested,props,events,attrs) - ) - ([],[],[],[],[],[]) - (Hashtbl.find_all ctx.il_relations (ITypeDef, td.td_id)) - in - { - cpath = cpath; - cflags = cflags; - csuper = csuper; - cfields = cfields; - cmethods = cmethods; - cevents = events; - cprops = props; - cimplements = impl; - ctypes = types; - cenclosing = enclosing; - cnested = nested; - cattrs = attrs; - } diff --git a/libs/ilib/ilMetaWriter.ml b/libs/ilib/ilMetaWriter.ml deleted file mode 100644 index c6daa544fa7..00000000000 --- a/libs/ilib/ilMetaWriter.ml +++ /dev/null @@ -1,78 +0,0 @@ -(* - * This file is part of ilLib - * Copyright (c)2004-2013 Haxe Foundation - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA - *) - -open PeData;; -open PeReader;; -open IlMeta;; -open IO;; - -(* encoding helpers *) - -let int_of_type_def_vis = function - (* visibility flags - mask 0x7 *) - | VPrivate -> 0x0 (* 0x0 *) - | VPublic -> 0x1 (* 0x1 *) - | VNestedPublic -> 0x2 (* 0x2 *) - | VNestedPrivate -> 0x3 (* 0x3 *) - | VNestedFamily -> 0x4 (* 0x4 *) - | VNestedAssembly -> 0x5 (* 0x5 *) - | VNestedFamAndAssem -> 0x6 (* 0x6 *) - | VNestedFamOrAssem -> 0x7 (* 0x7 *) - -let int_of_type_def_layout = function - (* layout flags - mask 0x18 *) - | LAuto -> 0x0 (* 0x0 *) - | LSequential -> 0x8 (* 0x8 *) - | LExplicit -> 0x10 (* 0x10 *) - -let int_of_type_def_semantics props = List.fold_left (fun acc prop -> - (match prop with - (* semantics flags - mask 0x5A0 *) - | SInterface -> 0x20 (* 0x20 *) - | SAbstract -> 0x80 (* 0x80 *) - | SSealed -> 0x100 (* 0x100 *) - | SSpecialName -> 0x400 (* 0x400 *) - ) lor acc - ) 0 props - -let int_of_type_def_impl props = List.fold_left (fun acc prop -> - (match prop with - (* type implementation flags - mask 0x103000 *) - | IImport -> 0x1000 (* 0x1000 *) - | ISerializable -> 0x2000 (* 0x2000 *) - | IBeforeFieldInit -> 0x00100000 (* 0x00100000 *) - ) lor acc - ) 0 props - -let int_of_type_def_string = function - (* string formatting flags - mask 0x00030000 *) - | SAnsi -> 0x0 (* 0x0 *) - | SUnicode -> 0x00010000 (* 0x00010000 *) - | SAutoChar -> 0x00020000 (* 0x00020000 *) - -let int_of_type_def_flags f = - int_of_type_def_vis f.tdf_vis - lor - int_of_type_def_layout f.tdf_layout - lor - int_of_type_def_semantics f.tdf_semantics - lor - int_of_type_def_impl f.tdf_impl - lor - int_of_type_def_string f.tdf_string diff --git a/libs/ilib/peData.ml b/libs/ilib/peData.ml deleted file mode 100644 index c513c6e777a..00000000000 --- a/libs/ilib/peData.ml +++ /dev/null @@ -1,548 +0,0 @@ -(* - * This file is part of ilLib - * Copyright (c)2004-2013 Haxe Foundation - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA - *) - -(* - This data is based on the - Microsoft Portable Executable and Common Object File Format Specification - Revision 8.3 -*) - -type machine_type = - | TUnknown (* 0 - unmanaged PE files only *) - | Ti386 (* 0x014c - i386 *) - | TR3000 (* 0x0162 - R3000 MIPS Little Endian *) - | TR4000 (* 0x0166 - R4000 MIPS Little Endian *) - | TR10000 (* 0x0168 - R10000 MIPS Little Endian *) - | TWCeMipsV2 (* 0x0169 - MIPS Little Endian running MS Windows CE 2 *) - | TAlpha (* 0x0184 - Alpha AXP *) - | TSh3 (* 0x01a2 - SH3 Little Endian *) - | TSh3Dsp (* 0x01a3 SH3DSP Little Endian *) - | TSh3e (* 0x01a4 SH3E Little Endian *) - | TSh4 (* 0x01a6 SH4 Little Endian *) - | TSh5 (* 0x01a8 SH5 *) - | TArm (* 0x1c0 ARM Little Endian *) - | TArmN (* 0x1c4 ARMv7 (or higher) Thumb mode only Little Endian *) - | TArm64 (* 0xaa64 - ARMv8 in 64-bit mode *) - | TEbc (* 0xebc - EFI byte code *) - | TThumb (* 0x1c2 ARM processor with Thumb decompressor *) - | TAm33 (* 0x1d3 AM33 processor *) - | TPowerPC (* 0x01f0 IBM PowerPC Little Endian *) - | TPowerPCFP (* 0x01f1 IBM PowerPC with FPU *) - | TItanium64 (* 0x0200 Intel IA64 (Itanium) *) - | TMips16 (* 0x0266 MIPS *) - | TAlpha64 (* 0x0284 Alpha AXP64 *) - | TMipsFpu (* 0x0366 MIPS with FPU *) - | TMipsFpu16 (* 0x0466 MIPS16 with FPU *) - | TTriCore (* 0x0520 Infineon *) - | TAmd64 (* 0x8664 AMD x64 and Intel E64T *) - | TM32R (* 0x9041 M32R *) - | TOSXAmd64 (* 0xC020 = 0x8664 xor 0x4644 OSX AMD x64 *) - | TLinuxAmd64 (* 0xFD1D = 0x8664 xor 0x7B79 Linux AMD x64 *) - -type coff_prop = - | RelocsStripped (* 0x1 *) - (* image file only. Indicates the file contains no base relocations and *) - (* must be loaded at its preferred base address. Should not be set for MPE files *) - | ExecutableImage (* 0x2 *) - (* Indicates that the file is an image file (EXE or DLL). Should be set for MPE files *) - | LineNumsStripped (* 0x4 *) - (* COFF line numbers have been removed. This flag should not be set for MPE files *) - (* because they do not use the debug info embedded in the PE file itself. They are saved on PDB files *) - | LocalSymsStripped (* 0x8 *) - (* COFF symbol table entries for local symbols have been removed. It should be set for MPE files *) - | AgressiveWsTrim (* 0x10 *) - (* Agressively trim the working set. This flag should not be set for pure-IL MPE files *) - | LargeAddressAware (* 0x20 *) - (* Application can handle addresses beyond the 2GB range. This flag should not be set for *) - (* pure-IL MPE files of versions 1 and 1.1, but can be set for v2.0 files *) - | BytesReversedLO (* 0x80 *) - (* Little endian. This flag should not be set for pure-IL MPE files *) - | Machine32Bit (* 0x100 *) - (* Machine is based on 32-bit architecture. This flag is usually set by the current *) - (* versions of code generators producing PE files. V2.0+ can produce 64-bit specific images *) - (* which don't have this flag set *) - | DebugStripped (* 0x200 *) - (* Debug information has been removed from the image file *) - | RemovableRunFromSwap (* 0x400 *) - (* If the image file is on removable media, copy and run it from swap file. *) - (* This flag should no be set for pure-IL MPE files *) - | NetRunFromSwap (* 0x800 *) - (* If the image file is on a network, copy and run it from the swap file. *) - (* This flag should no be set for pure-IL MPE files *) - | FileSystem (* 0x1000 *) - (* The image file is a system file (for example, a device driver) *) - (* This flag should not be set for pure-IL MPE files *) - | FileDll (* 0x2000 *) - (* This image file is a DLL rather than an EXE. It cannot be directly run. *) - | UpSystemOnly (* 0x4000 *) - (* The image file should be run on an uniprocessor machine only. *) - (* This flag should not be set for pure-IL MPE files *) - | BytesReversedHI (* 0x8000 *) - (* Big endian *) - (* This flag should not be set for pure-IL MPE files *) - -(* represents a virtual address pointer. It's 64-bit on 64-bit executables, and 32-bit otherwise *) -type pointer = int64 - -(* represents a memory index address on the target architecture. It's 64-bit on 64-bit executables, and 32-bit otherwise *) -type size_t = pointer - -(* relative virtual address. *) -(* it's always 32-bit - which means that PE/COFF files are still limited to the 4GB size *) -type rva = int32 - -(* represents a PE file-bound memory index *) -type size_t_file = int32 - -(* represents a file offset *) -(* there's no point in defining it as int32, as file seek operations need an int *) -type pointer_file = int - -type coff_header = { - coff_machine : machine_type; (* offset 0 - size 2 . *) - (* If the managed PE file is intended for various machine types (AnyCPU), it should be Ti386 *) - coff_nsections : int; (* O2S2 *) - coff_timestamp : int32; (* O4S4 *) - coff_symbol_table_pointer : rva; (* O8S4 *) - (* File pointer of the COFF symbol table. In managed PE files, it is 0 *) - coff_nsymbols : int; (* O12S4 *) - (* Number of entries in the COFF symbol table. Should be 0 in managed PE files *) - coff_optheader_size: int; (* O16S2 *) - (* Size of the PE header *) - coff_props : coff_prop list; -} - -let coff_default_exe_props = [ ExecutableImage; LineNumsStripped; LocalSymsStripped; (* Machine32Bit; *) ] - -let coff_default_dll_props = [ ExecutableImage; LineNumsStripped; LocalSymsStripped; (* Machine32Bit; *) FileDll ] - -type pe_magic = - | P32 (* 0x10b *) - | PRom (* 0x107 *) - | P64 (* 0x20b - called PE32+ on the docs *) - (* allows 64-bit address space while limiting the image size to 2 gb *) - -type subsystem = - | SUnknown (* 0 *) - | SNative (* 1 *) - (* Device drivers and native windows processes *) - | SWGui (* 2 *) - (* Windows GUI subsystem *) - | SWCui (* 3 *) - (* Windows character subsystem *) - | SPCui (* 7 *) - (* Posix character subsystem *) - | SWCeGui (* 9 *) - (* Windows CE subsystem *) - | SEfi (* 10 *) - (* EFI application *) - | SEfiBoot (* 11 *) - (* EFI driver with boot services *) - | SEfiRuntime (* 12 *) - (* EFI driver with run-time services *) - | SEfiRom (* 13 *) - (* EFI ROM Image *) - | SXbox (* 14 *) - -type dll_prop = - | DDynamicBase (* 0x0040 *) - (* DLL can be relocated at load time *) - | DForceIntegrity (* 0x0080 *) - (* Code integrity checks are enforced *) - | DNxCompat (* 0x0100 *) - (* Image is NX compatible *) - | DNoIsolation (* 0x0200 *) - (* Isolation-aware, but do not isolate the image *) - | DNoSeh (* 0x0400 *) - (* No structured exception handling *) - | DNoBind (* 0x0800 *) - (* Do not bind the image *) - | DWdmDriver (* 0x2000 *) - (* A WDM driver *) - | DTerminalServer (* 0x8000 *) - (* Terminal server aware *) - -type directory_type = - | ExportTable (* .edata *) - (* contains information about four other tables, which hold data describing *) - (* unmanaged exports of the PE file. ILAsm and VC++ linker are capable of exposing *) - (* the managed PE file as unmanaged exports *) - | ImportTable (* .idata *) - (* data on unmanaged imports consumed by the PE file. Only the VC++ linker makes *) - (* use of this table, by marking the imported unmanaged external functions used by *) - (* the unmanaged native code embedded in the same assembly. Other compilers only *) - (* contain a single entry - that of the CLR entry function *) - | ResourceTable (* .rsrc *) - (* unmanaged resources embedded in the PE file. Managed resources don't use this *) - | ExceptionTable (* .pdata *) - (* unmanaged exceptions only *) - | CertificateTable - (* points to a table of attribute certificates, used for file authentication *) - (* the first field of this entry is a file pointer rather than an RVA *) - | RelocTable (* .reloc *) - (* relocation table. We need to be aware of it if we use native TLS. *) - (* only the VC++ linker uses native TLS' *) - | DebugTable - (* unmanaged debug data starting address and size. A managed PE file doesn't carry *) - (* embedded debug data, so this data is either all zero or points to a 30-byte debug dir entry *) - (* of type 2 (IMAGE_DEBUG_TYPE_CODEVIEW), which in turn points to a CodeView-style header, containing *) - (* the path to the PDB debug file. *) - | ArchitectureTable - (* for i386, Itanium64 or AMD64, this data is set to all zeros *) - | GlobalPointer - (* the RVA of the value to be stored in the global pointer register. Size must be 0. *) - (* if the target architecture (e.g. i386 or AMD64) don't use the concept of a global pointer, *) - (* it is set to all zeros *) - | TlsTable (* .tls *) - (* The thread-local storage data. Only the VC++ linker and IL assembler produce code that use it *) - | LoadConfigTable - (* data specific to Windows NT OS *) - | BoundImportTable - (* array of bound import descriptors, each of which describes a DLL this image was bound *) - (* at link-time, along with time stamps of the bindings. Iff they are up-to-date, the OS loader *) - (* uses these bindings as a "shortcut" for API import *) - | ImportAddressTable - (* referenced from the Import Directory table (data directory 1) *) - | DelayImport - (* delay-load imports are DLLs described as implicit imports but loaded as explicit imports *) - (* (via calls to the LoadLibrary API) *) - | ClrRuntimeHeader (* .cormeta *) - (* pointer to the clr_runtime_header *) - | Reserved - (* must be zero *) - | Custom of int - -let directory_type_info = function - | ExportTable -> 0, "ExportTable" - | ImportTable -> 1, "ImportTable" - | ResourceTable -> 2, "ResourceTable" - | ExceptionTable -> 3, "ExceptionTable" - | CertificateTable -> 4, "CertificateTable" - | RelocTable -> 5, "RelocTable" - | DebugTable -> 6, "DebugTable" - | ArchitectureTable -> 7, "ArchTable" - | GlobalPointer -> 8, "GlobalPointer" - | TlsTable -> 9, "TlsTable" - | LoadConfigTable -> 10, "LoadConfigTable" - | BoundImportTable -> 11, "BuildImportTable" - | ImportAddressTable -> 12, "ImportAddressTable" - | DelayImport -> 13, "DelayImport" - | ClrRuntimeHeader -> 14, "ClrRuntimeHeader" - | Reserved -> 15, "Reserved" - | Custom i -> i, "Custom" ^ (string_of_int i) - -let directory_type_of_int = function - | 0 -> ExportTable - | 1 -> ImportTable - | 2 -> ResourceTable - | 3 -> ExceptionTable - | 4 -> CertificateTable - | 5 -> RelocTable - | 6 -> DebugTable - | 7 -> ArchitectureTable - | 8 -> GlobalPointer - | 9 -> TlsTable - | 10 -> LoadConfigTable - | 11 -> BoundImportTable - | 12 -> ImportAddressTable - | 13 -> DelayImport - | 14 -> ClrRuntimeHeader - | 15 -> Reserved - | i -> Custom i - -type section_prop = - | SNoPad (* 0x8 *) - (* the section should not be padded to the next boundary. *) - (* OBSOLETE - replaced by SAlign1Bytes *) - | SHasCode (* 0x20 *) - (* the section contains executable code *) - | SHasIData (* 0x40 *) - (* contains initialized data *) - | SHasData (* 0x80 *) - (* contains uninitialized data *) - | SHasLinkInfo (* 0x200 *) - (* contains comments or other information. only valid for object files *) - | SLinkRemove (* 0x1000 *) - (* this will not become part of the image. only valid for object files *) - | SGlobalRel (* 0x8000 *) - (* contains data referenced through the global pointer (GP) *) - | SHas16BitMem (* 0x20000 *) - (* for ARM architecture. The section contains Thumb code *) - | SAlign1Bytes (* 0x100000 *) - (* align data on a 1-byte boundary. valid only for object files *) - | SAlign2Bytes (* 0x200000 *) - | SAlign4Bytes (* 0x300000 *) - | SAlign8Bytes (* 0x400000 *) - | SAlign16Bytes (* 0x500000 *) - | SAlign32Bytes (* 0x600000 *) - | SAlign64Bytes (* 0x700000 *) - | SAlign128Bytes (* 0x800000 *) - | SAlign256Bytes (* 0x900000 *) - | SAlign512Bytes (* 0xA00000 *) - | SAlign1024Bytes (* 0xB00000 *) - | SAlign2048Bytes (* 0xC00000 *) - | SAlign4096Bytes (* 0xD00000 *) - | SAlign8192Bytes (* 0xE00000 *) - | SHasExtRelocs (* 0x1000000 *) - (* section contains extended relocations *) - | SCanDiscard (* 0x02000000 *) - (* section can be discarded as needed *) - | SNotCached (* 0x04000000 *) - (* section cannot be cached *) - | SNotPaged (* 0x08000000 *) - (* section is not pageable *) - | SShared (* 0x10000000 *) - (* section can be shared in memory *) - | SExec (* 0x20000000 *) - (* section can be executed as code *) - | SRead (* 0x40000000 *) - (* section can be read *) - | SWrite (* 0x80000000 *) - (* section can be written to *) - -type pe_section = { - s_name : string; - (* an 8-byte, null-padded UTF-8 encoded string *) - s_vsize : size_t_file; - (* the total size of the section when loaded into memory. *) - (* if less than s_rawsize, the section is zero-padded *) - (* should be set to 0 on object files *) - s_vaddr : rva; - (* the RVA of the beginning of the section *) - s_raw_size : size_t_file; - (* the size of the initialized data on disk, rounded up to a multiple *) - (* of the file alignment value. If it's less than s_vsize, it should be *) - (* zero filled. It may happen that rawsize is greater than vsize. *) - s_raw_pointer : pointer_file; - (* the file pointer to the first page of the section within the COFF file *) - (* on executable images, this must be a multiple of file aignment value. *) - (* for object files, it should be aligned on a 4byte boundary *) - s_reloc_pointer : pointer_file; - (* the file pointer to the beginning of relocation entries for this section *) - (* this is set to zero for executable images or if there are no relocations *) - s_line_num_pointer : pointer_file; - (* the file pointer to the beginning of line-number entries for this section *) - (* must be 0 : COFF debugging image is deprecated *) - s_nrelocs : int; - (* number of relocation entries *) - s_nline_nums : int; - (* number of line number entries *) - s_props : section_prop list; - (* properties of the section *) -} - -(* The size of the PE header is not fixed. It depends on the number of data directories defined in the header *) -(* and is specified in the optheader_size in the COFF header *) -(* object files don't have this; but it's required for image files *) -type pe_header = { - pe_coff_header : coff_header; - (* Standard fields *) - pe_magic : pe_magic; - pe_major : int; - pe_minor : int; - pe_code_size : int; - (* size of the code section (.text) or the sum of all code sections, *) - (* if multiple sections exist. The IL assembler always emits a single code section *) - pe_init_size : int; - pe_uinit_size : int; - pe_entry_addr : rva; - (* RVA of the beginning of the entry point function. For unmanaged DLLs, this can be 0 *) - (* For managed PE files, this always points to the CLR invocation stub *) - pe_base_code : rva; - (* The address that is relative to the image base of the beginning-of-code section *) - (* when it's loaded into memory *) - pe_base_data : rva; - (* The address that is relative to the image base of the beginning-of-data section *) - (* when it's loaded into memory *) - - (* COFF Windows extension *) - pe_image_base : pointer; - (* The preferred address of the first byte of image when loaded into memory. *) - (* Should be a multiple of 64K *) - pe_section_alignment : int; - (* The alignment in bytes of sections when they are loaded into memory *) - (* It must be greater than or equal to FileAlignment. The default is the page size *) - (* for the architecture *) - (* x86 MPE files should have an alignment of 8KB, even though only 4KB would be needed *) - (* for compatibility with 64-bits *) - pe_file_alignment : int; - (* The alignment factor in bytes that is used to align the raw data of sections *) - (* in the image file. The value should be a POT between 512 and 64K. *) - (* If secion_alignment is less than architecture's page size, file_alignment must match *) - (* secion_alignment *) - pe_major_osver : int; - pe_minor_osver : int; - pe_major_imgver : int; - pe_minor_imgver : int; - pe_major_subsysver : int; - pe_minor_subsysver : int; - pe_image_size : int; - (* the size of the image in bytes, as the image is loaded into memory *) - (* must be a multiple of section_alignment *) - pe_headers_size : int; - (* the combined size of an MSDOS stub, PE header, and section headers *) - (* rounded up to a multiple of FileAlignment *) - pe_checksum : int32; - pe_subsystem : subsystem; - pe_dll_props : dll_prop list; - (* in MPE files of v1.0, always set to 0; In MPE of v1.1 and later, *) - (* always set to 0x400 (DNoSeh) *) - pe_stack_reserve : size_t; - (* the size of the stack to reserve. Only pe_stack_commit is committed *) - pe_stack_commit : size_t; - (* the size of the stack to commit *) - pe_heap_reserve : size_t; - (* the size of the local heap space to reserve. Only pe_heap_commit is committed *) - pe_heap_commit : size_t; - (* the size of the heap to commit *) - pe_ndata_dir : int; - (* the number of data-directory entries in the remainder of the optional header *) - (* should be at least 16. Although is possible to emit more than 16 data directories, *) - (* all existing managed compilers emit exactly 16 data directories, with the last never *) - (* used (reserved) *) - pe_data_dirs : (rva * size_t_file) array; - (* data directories are RVA's that point to sections on the PE that have special significance *) - (* see directory_type docs *) - - (* sections *) - pe_sections : pe_section array; -} - -(* raw .idata table *) -(* not used : only here for documentation purposes *) -type idata_table_raw = { - impr_lookup_table : rva; - (* the RVA of the lookup table *) - impr_timestamp : int32; - (* on bound images, it's set to the timestamp of the DLL *) - impr_fchain : int32; - (* the index of the first forwarder reference - which are references *) - (* that are both imported and exported *) - impr_name : rva; - (* the RVA to an ASCII string that contains the name of the DLL *) - impr_address_table : rva; - (* RVA of the import address table. The contents are identical to the imp_lookup_table *) - (* until the image is bound *) -} - -(* a symbol lookup can happen either by name, or by ordinal. *) -(* lookup by name happens to be an extra indirection, as the loader *) -(* uses the name to look up the export ordinal anyway. *) -(* Most (if not all) MPE will do a lookup by name, though *) -type symbol_lookup = - | SName of int * string - | SOrdinal of int - -type idata_table = { - imp_name : string; - (* ASCII string that contains the name of the DLL *) - imp_imports : symbol_lookup list; -} - -type clr_flag = - | FIlOnly (* 0x1 *) - (* the image file contains IL code only, with no embedded native unmanaged code *) - (* this can cause some problems on WXP+, because the .reloc section is ignored when this flag is set *) - (* e.g. if native TLS support is used. In this case the VC++ compiler unsets this flag *) - | F32BitRequired (* 0x2 *) - (* the file can be only loaded into a 32-bit process *) - | FIlLibrary (* 0x4 *) - (* obsolete *) - | FSigned (* 0x8 *) - (* the image file is protected with a strong name signature *) - | FNativeEntry (* 0x10 *) - (* the executable's entry point is an unmanaged method. *) - (* the EntryPointToken / EntryPointRVA field of the CLR header *) - (* contains the RVA of this native method *) - | FTrackDebug (* 0x10000 *) - (* the CLR loader is required to track debug information about the methods. This flag is not used *) - -type clr_header = { - clr_cb : int; - (* size of header *) - clr_major : int; - clr_minor : int; - - (* symbol table and startup information *) - clr_meta : rva * size_t_file; - clr_flags : clr_flag list; - clr_entry_point : rva; - (* metadata identifier (token) of the entry point for the image file *) - (* can be 0 for DLL images. This field identifies a method belonging to this module *) - (* or a module containing the entry point method. This field may contain RVA of the *) - (* embedded native entry point method, if FNativeEntry flag is set *) - - (* binding information *) - clr_res : rva * size_t_file; - (* RVA of managed resources *) - clr_sig : rva * size_t_file; - (* RVA of the hash data for this PE file, used by the loader for binding and versioning *) - - (* regular fixup and binding information *) - clr_codeman : rva * size_t_file; - (* code manager table - RESERVED and should be 0 *) - clr_vtable_fix : rva * size_t_file; - (* RVA of an array of vtable fixups. Only VC++ linker and IL assembler produce data in this array *) - clr_export_address : rva * size_t_file; - (* rva of addresses of jump thunks. obsolete and should be set to 0 *) -} - -(* unused structure: documentation purposes only *) -type clr_stream_header = { - str_offset : pointer_file; - (* the (relative to the start of metadata) offset in the file for this stream *) - str_size : size_t_file; - (* the size of the stream in bytes *) - str_name : string; - (* name of the stream - a zero-terminated ASCII string no longer than 31 characters (plus 0 terminator) *) - (* if the stream name is smaller, it can be reduced - but must be padded to the 4-byte boundary *) -} - -(* unused structure: documentation purposes only *) -type clr_meta_table = { - (* storage signature *) - meta_magic : string; - (* always BSJB *) - meta_major : int; - meta_minor : int; - (* meta_extra : int; *) - (* reserved; always 0 *) - meta_ver : string; - (* encoded by first passing its length *) - - (* storage header *) - (* meta_flags : int; *) - (* reserved; always 0 *) - meta_nstreams : int; - (* number of streams *) - meta_strings_stream : clr_stream_header; - (* #Strings: a string heap containing the names of metadata items *) - meta_blob_stream : clr_stream_header; - (* #Blob: blob heap containing internal metadata binary object, such as default values, signatures, etc *) - meta_guid_stream : clr_stream_header; - (* #GUID: a GUID heap *) - meta_us_stream : clr_stream_header; - (* #US: user-defined strings *) - meta_meta_stream : clr_stream_header; - (* may be either: *) - (* #~: compressed (optimized) metadata stream *) - (* #-: uncompressed (unoptimized) metadata stream *) - meta_streams : clr_stream_header list; - (* custom streams *) -} diff --git a/libs/ilib/peDataDebug.ml b/libs/ilib/peDataDebug.ml deleted file mode 100644 index 4b52c11c150..00000000000 --- a/libs/ilib/peDataDebug.ml +++ /dev/null @@ -1,186 +0,0 @@ -(* - * This file is part of ilLib - * Copyright (c)2004-2013 Haxe Foundation - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA - *) -open PeData;; -open Printf;; - -let machine_type_s m = match m with - | TUnknown -> "TUnknown" - | Ti386 -> "Ti386" - | TR3000 -> "TR3000" - | TR4000 -> "TR4000" - | TR10000 -> "TR10000" - | TWCeMipsV2 -> "TWCeMipsV2" - | TAlpha -> "TAlpha" - | TSh3 -> "TSh3" - | TSh3Dsp -> "TSh3Dsp" - | TSh3e -> "TSh3e" - | TSh4 -> "TSh4" - | TSh5 -> "TSh5" - | TArm -> "TArm" - | TArmN -> "TArmN" - | TArm64 -> "TArm64" - | TEbc -> "TEbc" - | TThumb -> "TThumb" - | TAm33 -> "TAm33" - | TPowerPC -> "TPowerPC" - | TPowerPCFP -> "TPowerPCFP" - | TItanium64 -> "TItanium64" - | TMips16 -> "TMips16" - | TAlpha64 -> "TAlpha64" - | TMipsFpu -> "TMipsFpu" - | TMipsFpu16 -> "TMipsFpu16" - | TTriCore -> "TTriCore" - | TAmd64 -> "TAmd64" - | TM32R -> "TM32R" - | TOSXAmd64 -> "TOSXAmd64" - | TLinuxAmd64 -> "TLinuxAmd64" - -let coff_prop_s p = match p with - | RelocsStripped -> "RelocsStripped" - | ExecutableImage -> "ExecutableImage" - | LineNumsStripped -> "LineNumsStripped" - | LocalSymsStripped -> "LocalSymsStripped" - | AgressiveWsTrim -> "AgressiveWsTrim" - | LargeAddressAware -> "LargeAddressAware" - | BytesReversedLO -> "BytesReversedLO" - | Machine32Bit -> "Machine32Bit" - | DebugStripped -> "DebugStripped" - | RemovableRunFromSwap -> "RemovableRunFromSwap" - | NetRunFromSwap -> "NetRunFromSwap" - | FileSystem -> "FileSystem" - | FileDll -> "FileDll" - | UpSystemOnly -> "UpSystemOnly" - | BytesReversedHI -> "BytesReversedHI" - -let coff_header_s h = - sprintf "#COFF_HEADER\n\tmachine: %s\n\tnsections: %d\n\ttimestamp: %ld\n\tsymbol_tbl_pointer: %ld\n\tnsymbols: %d\n\toptheader_size: %x\n\tprops: [%s]\n" - (machine_type_s h.coff_machine) - h.coff_nsections - h.coff_timestamp - h.coff_symbol_table_pointer - h.coff_nsymbols - h.coff_optheader_size - (String.concat ", " (List.map coff_prop_s h.coff_props)) - -let pe_magic_s = function - | P32 -> "P32" - | PRom -> "PRom" - | P64 -> "P64" - -let subsystem_s = function - | SUnknown -> "SUnknown" (* 0 *) - | SNative -> "SNative" (* 1 *) - | SWGui -> "SWGui" (* 2 *) - | SWCui -> "SWCui" (* 3 *) - | SPCui -> "SPCui" (* 7 *) - | SWCeGui -> "SWCeGui" (* 9 *) - | SEfi -> "SEfi" (* 10 *) - | SEfiBoot -> "SEfiBoot" (* 11 *) - | SEfiRuntime -> "SEfiRuntime" (* 12 *) - | SEfiRom -> "SEfiRom" (* 13 *) - | SXbox -> "SXbox" (* 14 *) - -let dll_prop_s = function - | DDynamicBase -> "DDynamicBase" (* 0x0040 *) - | DForceIntegrity -> "DForceIntegrity" (* 0x0080 *) - | DNxCompat -> "DNxCompat" (* 0x0100 *) - | DNoIsolation -> "DNoIsolation" (* 0x0200 *) - | DNoSeh -> "DNoSeh" (* 0x0400 *) - | DNoBind -> "DNoBind" (* 0x0800 *) - | DWdmDriver -> "DWdmDriver" (* 0x2000 *) - | DTerminalServer -> "DTerminalServer" (* 0x8000 *) - -let section_prop_s = function - | SNoPad -> "SNoPad" - | SHasCode -> "SHasCode" - | SHasIData -> "SHasIData" - | SHasData -> "SHasData" - | SHasLinkInfo -> "SHasLinkInfo" - | SLinkRemove -> "SLinkRemove" - | SGlobalRel -> "SGlobalRel" - | SHas16BitMem -> "SHas16BitMem" - | SAlign1Bytes -> "SAlign1Bytes" - | SAlign2Bytes -> "SAlign2Bytes" - | SAlign4Bytes -> "SAlign4Bytes" - | SAlign8Bytes -> "SAlign8Bytes" - | SAlign16Bytes -> "SAlign16Bytes" - | SAlign32Bytes -> "SAlign32Bytes" - | SAlign64Bytes -> "SAlign64Bytes" - | SAlign128Bytes -> "SAlign128Bytes" - | SAlign256Bytes -> "SAlign256Bytes" - | SAlign512Bytes -> "SAlign512Bytes" - | SAlign1024Bytes -> "SAlign1024Bytes" - | SAlign2048Bytes -> "SAlign2048Bytes" - | SAlign4096Bytes -> "SAlign4096Bytes" - | SAlign8192Bytes -> "SAlign8192Bytes" - | SHasExtRelocs -> "SHasExtRelocs" - | SCanDiscard -> "SCanDiscard" - | SNotCached -> "SNotCached" - | SNotPaged -> "SNotPaged" - | SShared -> "SShared" - | SExec -> "SExec" - | SRead -> "SRead" - | SWrite -> "SWrite" - -let pe_section_s s = - Printf.sprintf "\t%s :\n\t\trva: %lx\n\t\traw size: %lx\n\t\tprops: [%s]" - s.s_name - s.s_vaddr - s.s_raw_size - (String.concat ", " (List.map section_prop_s s.s_props)) - -let data_dirs_s a = - let lst = Array.to_list (Array.mapi (fun i (r,l) -> - let _,s = directory_type_info (directory_type_of_int i) in - Printf.sprintf "%s: %lx (%lx)" s r l - ) a) in - String.concat "\n\t\t" lst - -let pe_header_s h = - sprintf "#PE_HEADER\n\tmagic: %s\n\tmajor.minor %d.%d\n\tsubsystem: %s\n\tdll props: [%s]\n\tndata_dir: %i\n\t\t%s\n#SECTIONS\n%s" - (pe_magic_s h.pe_magic) - h.pe_major h.pe_minor - (subsystem_s h.pe_subsystem) - (String.concat ", " (List.map dll_prop_s h.pe_dll_props)) - h.pe_ndata_dir - (data_dirs_s h.pe_data_dirs) - (String.concat "\n" (List.map pe_section_s (Array.to_list h.pe_sections))) - -let symbol_lookup_s = function - | SName (hint,s) -> "SName(" ^ string_of_int hint ^ ", " ^ s ^ ")" - | SOrdinal i -> "SOrdinal(" ^ string_of_int i ^ ")" - -let idata_table_s t = - sprintf "#IMPORT %s:\n\t%s" - t.imp_name - (String.concat "\n\t" (List.map symbol_lookup_s t.imp_imports)) - -let clr_flag_s = function - | FIlOnly -> "FIlOnly" (* 0x1 *) - | F32BitRequired -> "F32BitRequired" (* 0x2 *) - | FIlLibrary -> "FIlLibrary" (* 0x4 *) - | FSigned -> "FSigned" (* 0x8 *) - | FNativeEntry -> "FNativeEntry" (* 0x10 *) - | FTrackDebug -> "FTrackDebug" (* 0x10000 *) - -let clr_header_s h = - sprintf "#CLR v%d.%d\n\tflags: %s" - h.clr_major - h.clr_minor - (String.concat ", " (List.map clr_flag_s h.clr_flags)) diff --git a/libs/ilib/peReader.ml b/libs/ilib/peReader.ml deleted file mode 100644 index 4d2e4aadb7a..00000000000 --- a/libs/ilib/peReader.ml +++ /dev/null @@ -1,495 +0,0 @@ -(* - * This file is part of ilLib - * Copyright (c)2004-2013 Haxe Foundation - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA - *) - -open PeData;; -open IO;; -open ExtString;; -open ExtList;; - -exception Error_message of string - -type reader_ctx = { - ch : Stdlib.in_channel; - i : IO.input; - verbose : bool; -} - -type ctx = { - r : reader_ctx; - pe_header : pe_header; - read_word : IO.input -> pointer; -} - -let error msg = raise (Error_message msg) - -let seek r pos = - seek_in r.ch pos - -let pos r = - Stdlib.pos_in r.ch - -let info r msg = - if r.verbose then - print_endline (msg()) - -let machine_type_of_int i = match i with - | 0x0 -> TUnknown (* 0 - unmanaged PE files only *) - | 0x014c -> Ti386 (* 0x014c - i386 *) - | 0x0162 -> TR3000 (* 0x0162 - R3000 MIPS Little Endian *) - | 0x0166 -> TR4000 (* 0x0166 - R4000 MIPS Little Endian *) - | 0x0168 -> TR10000 (* 0x0168 - R10000 MIPS Little Endian *) - | 0x0169 -> TWCeMipsV2 (* 0x0169 - MIPS Litlte Endian running MS Windows CE 2 *) - | 0x0184 -> TAlpha (* 0x0184 - Alpha AXP *) - | 0x01a2 -> TSh3 (* 0x01a2 - SH3 Little Endian *) - | 0x01a3 -> TSh3Dsp (* 0x01a3 SH3DSP Little Endian *) - | 0x01a4 -> TSh3e (* 0x01a4 SH3E Little Endian *) - | 0x01a6 -> TSh4 (* 0x01a6 SH4 Little Endian *) - | 0x01a8 -> TSh5 - | 0x01c0 -> TArm (* 0x1c0 ARM Little Endian *) - | 0x01c2 -> TThumb (* 0x1c2 ARM processor with Thumb decompressor *) - | 0x01c4 -> TArmN (* 0x1c0 ARM Little Endian *) - | 0xaa64 -> TArm64 - | 0xebc -> TEbc - | 0x01d3 -> TAm33 (* 0x1d3 AM33 processor *) - | 0x01f0 -> TPowerPC (* 0x01f0 IBM PowerPC Little Endian *) - | 0x01f1 -> TPowerPCFP (* 0x01f1 IBM PowerPC with FPU *) - | 0x0200 -> TItanium64 (* 0x0200 Intel IA64 (Itanium( *) - | 0x0266 -> TMips16 (* 0x0266 MIPS *) - | 0x0284 -> TAlpha64 (* 0x0284 Alpha AXP64 *) - | 0x0366 -> TMipsFpu (* 0x0366 MIPS with FPU *) - | 0x0466 -> TMipsFpu16 (* 0x0466 MIPS16 with FPU *) - | 0x0520 -> TTriCore (* 0x0520 Infineon *) - | 0x8664 -> TAmd64 (* 0x8664 AMD x64 and Intel E64T *) - | 0x9041 -> TM32R (* 0x9041 M32R *) - | 0xC020 -> TOSXAmd64 (* 0xC020 OSX AMD x64 *) - | 0xFD1D -> TLinuxAmd64 (* 0xFD1D Linux AMD x64 *) - | _ -> assert false - -let coff_props_of_int iprops = List.fold_left (fun acc i -> - if (iprops land i) = i then (match i with - | 0x1 -> RelocsStripped (* 0x1 *) - | 0x2 -> ExecutableImage (* 0x2 *) - | 0x4 -> LineNumsStripped (* 0x4 *) - | 0x8 -> LocalSymsStripped (* 0x8 *) - | 0x10 -> AgressiveWsTrim (* 0x10 *) - | 0x20 -> LargeAddressAware (* 0x20 *) - | 0x80 -> BytesReversedLO (* 0x80 *) - | 0x100 -> Machine32Bit (* 0x100 *) - | 0x200 -> DebugStripped (* 0x200 *) - | 0x400 -> RemovableRunFromSwap (* 0x400 *) - | 0x800 -> NetRunFromSwap (* 0x800 *) - | 0x1000 -> FileSystem (* 0x1000 *) - | 0x2000 -> FileDll (* 0x2000 *) - | 0x4000 -> UpSystemOnly (* 0x4000 *) - | 0x8000 -> BytesReversedHI (* 0x8000 *) - | _ -> assert false) :: acc - else - acc) [] [0x1;0x2;0x4;0x8;0x10;0x20;0x80;0x100;0x200;0x400;0x800;0x1000;0x2000;0x4000;0x8000] - -let section_props_of_int32 props = List.fold_left (fun acc i -> - if (Int32.logand props i) = i then (match i with - | 0x8l -> SNoPad - | 0x20l -> SHasCode - | 0x40l -> SHasIData - | 0x80l -> SHasData - | 0x200l -> SHasLinkInfo - | 0x1000l -> SLinkRemove - | 0x8000l -> SGlobalRel - | 0x20000l -> SHas16BitMem - | 0x100000l -> SAlign1Bytes - | 0x200000l -> SAlign2Bytes - | 0x300000l -> SAlign4Bytes - | 0x400000l -> SAlign8Bytes - | 0x500000l -> SAlign16Bytes - | 0x600000l -> SAlign32Bytes - | 0x700000l -> SAlign64Bytes - | 0x800000l -> SAlign128Bytes - | 0x900000l -> SAlign256Bytes - | 0xA00000l -> SAlign512Bytes - | 0xB00000l -> SAlign1024Bytes - | 0xC00000l -> SAlign2048Bytes - | 0xD00000l -> SAlign4096Bytes - | 0xE00000l -> SAlign8192Bytes - | 0x1000000l -> SHasExtRelocs - | 0x02000000l -> SCanDiscard - | 0x04000000l -> SNotCached - | 0x08000000l -> SNotPaged - | 0x10000000l -> SShared - | 0x20000000l -> SExec - | 0x40000000l -> SRead - | 0x80000000l -> SWrite - | _ -> assert false) :: acc - else - acc) [] [ 0x8l; 0x20l; 0x40l; 0x80l; 0x200l; 0x1000l; 0x8000l; 0x20000l; 0x100000l; 0x200000l; 0x300000l; 0x400000l; 0x500000l; 0x600000l; 0x700000l; 0x800000l; 0x900000l; 0xA00000l; 0xB00000l; 0xC00000l; 0xD00000l; 0xE00000l; 0x1000000l; 0x02000000l; 0x04000000l; 0x08000000l; 0x10000000l; 0x20000000l; 0x40000000l; 0x80000000l; ] - -let subsystem_of_int i = match i with - | 0 -> SUnknown (* 0 *) - | 1 -> SNative (* 1 *) - | 2 -> SWGui (* 2 *) - | 3 -> SWCui (* 3 *) - | 7 -> SPCui (* 7 *) - | 9 -> SWCeGui (* 9 *) - | 10 -> SEfi (* 10 *) - | 11 -> SEfiBoot (* 11 *) - | 12 -> SEfiRuntime (* 12 *) - | 13 -> SEfiRom (* 13 *) - | 14 -> SXbox (* 14 *) - | _ -> error ("Unknown subsystem " ^ string_of_int i) - -let dll_props_of_int iprops = List.fold_left (fun acc i -> - if (iprops land i) = i then (match i with - | 0x0040 -> DDynamicBase (* 0x0040 *) - | 0x0080 -> DForceIntegrity (* 0x0080 *) - | 0x0100 -> DNxCompat (* 0x0100 *) - | 0x0200 -> DNoIsolation (* 0x0200 *) - | 0x0400 -> DNoSeh (* 0x0400 *) - | 0x0800 -> DNoBind (* 0x0800 *) - | 0x2000 -> DWdmDriver (* 0x2000 *) - | 0x8000 -> DTerminalServer (* 0x8000 *) - | _ -> assert false) :: acc - else - acc) [] [0x40;0x80;0x100;0x200;0x400;0x800;0x2000;0x8000] - -let pe_magic_of_int i = match i with - | 0x10b -> P32 - | 0x107 -> PRom - | 0x20b -> P64 - | _ -> error ("Unknown PE magic number: " ^ string_of_int i) - -let clr_flags_of_int iprops = List.fold_left (fun acc i -> - if (iprops land i) = i then (match i with - | 0x1 -> FIlOnly (* 0x1 *) - | 0x2 -> F32BitRequired (* 0x2 *) - | 0x4 -> FIlLibrary (* 0x4 *) - | 0x8 -> FSigned (* 0x8 *) - | 0x10 -> FNativeEntry (* 0x10 *) - | 0x10000 -> FTrackDebug (* 0x10000 *) - | _ -> assert false) :: acc - else - acc) [] [0x1;0x2;0x4;0x8;0x10;0x10000] - -let get_dir dir ctx = - let idx,name = directory_type_info dir in - try - ctx.pe_header.pe_data_dirs.(idx) - with - | Invalid_argument _ -> - error (Printf.sprintf "The directory '%s' of index '%i' is required but is missing on this file" name idx) - -let read_rva = read_real_i32 - -let read_word is64 i = - if is64 then read_i64 i else Int64.logand (Int64.of_int32 (read_real_i32 i)) 0xFFFFFFFFL - -let read_coff_header i = - let machine = machine_type_of_int (read_ui16 i) in - let nsections = read_ui16 i in - let stamp = read_real_i32 i in - let symbol_table_pointer = read_rva i in - let nsymbols = read_i32 i in - let optheader_size = read_ui16 i in - let props = read_ui16 i in - let props = coff_props_of_int (props) in - { - coff_machine = machine; - coff_nsections = nsections; - coff_timestamp = stamp; - coff_symbol_table_pointer = symbol_table_pointer; - coff_nsymbols = nsymbols; - coff_optheader_size = optheader_size; - coff_props = props; - } - -let read_pe_header r header = - let i = r.i in - let sections_offset = (pos r) + header.coff_optheader_size in - let magic = pe_magic_of_int (read_ui16 i) in - let major = read_byte i in - let minor = read_byte i in - let code_size = read_i32 i in - let init_size = read_i32 i in - let uinit_size = read_i32 i in - let entry_addr = read_rva i in - let base_code = read_rva i in - let base_data, read_word = match magic with - | P32 | PRom -> - read_rva i, read_word false - | P64 -> - Int32.zero, read_word true - in - - (* COFF Windows extension *) - let image_base = read_word i in - let section_alignment = read_i32 i in - let file_alignment = read_i32 i in - let major_osver = read_ui16 i in - let minor_osver = read_ui16 i in - let major_imgver = read_ui16 i in - let minor_imgver = read_ui16 i in - let major_subsysver = read_ui16 i in - let minor_subsysver = read_ui16 i in - ignore (read_i32 i); (* reserved *) - let image_size = read_i32 i in - let headers_size = read_i32 i in - let checksum = read_real_i32 i in - let subsystem = subsystem_of_int (read_ui16 i) in - let dll_props = dll_props_of_int (read_ui16 i) in - let stack_reserve = read_word i in - let stack_commit = read_word i in - let heap_reserve = read_word i in - let heap_commit = read_word i in - ignore (read_i32 i); (* reserved *) - let ndata_dir = read_i32 i in - let data_dirs = Array.init ndata_dir (fun n -> - let addr = read_rva i in - let size = read_rva i in - addr,size) - in - (* sections *) - let nsections = header.coff_nsections in - seek r sections_offset; - let sections = Array.init nsections (fun n -> - let name = nread_string i 8 in - let name = try - let index = String.index name '\x00' in - String.sub name 0 index - with | Not_found -> - name - in - (*TODO check for slash names *) - let vsize = read_rva i in - let vaddr = read_rva i in - let raw_size = read_rva i in - let raw_pointer = read_i32 i in - let reloc_pointer = read_i32 i in - let line_num_pointer = read_i32 i in - let nrelocs = read_ui16 i in - let nline_nums = read_ui16 i in - let props = section_props_of_int32 (read_rva i) in - { - s_name = name; - s_vsize =vsize; - s_vaddr =vaddr; - s_raw_size =raw_size; - s_raw_pointer =raw_pointer; - s_reloc_pointer =reloc_pointer; - s_line_num_pointer =line_num_pointer; - s_nrelocs =nrelocs; - s_nline_nums =nline_nums; - s_props =props; - } - ) in - { - pe_coff_header = header; - pe_magic = magic; - pe_major = major; - pe_minor = minor; - pe_code_size = code_size; - pe_init_size = init_size; - pe_uinit_size = uinit_size; - pe_entry_addr = entry_addr; - pe_base_code = base_code; - pe_base_data = base_data; - pe_image_base = image_base; - pe_section_alignment = section_alignment; - pe_file_alignment = file_alignment; - pe_major_osver = major_osver; - pe_minor_osver = minor_osver; - pe_major_imgver = major_imgver; - pe_minor_imgver = minor_imgver; - pe_major_subsysver = major_subsysver; - pe_minor_subsysver = minor_subsysver; - pe_image_size = image_size; - pe_headers_size = headers_size; - pe_checksum = checksum; - pe_subsystem = subsystem; - pe_dll_props = dll_props; - pe_stack_reserve = stack_reserve; - pe_stack_commit = stack_commit; - pe_heap_reserve = heap_reserve; - pe_heap_commit = heap_commit; - pe_ndata_dir = ndata_dir; - pe_data_dirs = data_dirs; - pe_sections = sections; - } - -let create_r ch props = - let verbose = PMap.mem "IL_VERBOSE" props in - let i = IO.input_channel ch in - { - ch = ch; - i = i; - verbose = verbose; - } - -(* converts an RVA into a file offset. *) -let convert_rva ctx rva = - let sections = ctx.pe_header.pe_sections in - let nsections = Array.length sections in - let sec = - (* linear search. TODO maybe binary search for many sections? *) - let rec loop n = - if n >= nsections then error (Printf.sprintf "The RVA %lx is outside sections bounds!" rva); - let sec = sections.(n) in - if rva >= sec.s_vaddr && (rva < (Int32.add sec.s_vaddr sec.s_raw_size)) then - sec - else - loop (n+1) - in - loop 0 - in - let diff = Int32.to_int (Int32.sub rva sec.s_vaddr) in - sec.s_raw_pointer + diff - -let seek_rva ctx rva = seek ctx.r (convert_rva ctx rva) - -let read_cstring i = - let ret = Buffer.create 8 in - let rec loop () = - let chr = read i in - if chr = '\x00' then - Buffer.contents ret - else begin - Buffer.add_char ret chr; - loop() - end - in - loop() - -(* reads import data *) -let read_idata ctx = match get_dir ImportTable ctx with - | 0l,_ | _,0l -> - [] - | rva,size -> - seek_rva ctx rva; - let i = ctx.r.i in - let rec loop acc = - let lookup_table = read_rva i in - if lookup_table = Int32.zero then - acc - else begin - let timestamp = read_real_i32 i in - let fchain = read_real_i32 i in - let name_rva = read_rva i in - let addr_table = read_rva i in - ignore addr_table; ignore fchain; ignore timestamp; - loop ((lookup_table,name_rva) :: acc) - end - in - let tables = loop [] in - List.rev_map (function (lookup_table,name_rva) -> - seek_rva ctx lookup_table; - let is_64 = ctx.pe_header.pe_magic = P64 in - let imports_data = if not is_64 then - let rec loop acc = - let flags = read_real_i32 i in - if flags = Int32.zero then - acc - else begin - let is_ordinal = Int32.logand flags 0x80000000l = 0x80000000l in - loop ( (is_ordinal, if is_ordinal then Int32.logand flags 0xFFFFl else Int32.logand flags 0x7FFFFFFFl) :: acc ) - end - in - loop [] - else - let rec loop acc = - let flags = read_i64 i in - if flags = Int64.zero then - acc - else begin - let is_ordinal = Int64.logand flags 0x8000000000000000L = 0x8000000000000000L in - loop ( (is_ordinal, Int64.to_int32 (if is_ordinal then Int64.logand flags 0xFFFFL else Int64.logand flags 0x7FFFFFFFL)) :: acc ) - end - in - loop [] - in - let imports = List.rev_map (function - | true, ord -> - SOrdinal (Int32.to_int ord) - | false, rva -> - seek_rva ctx rva; - let hint = read_ui16 i in - SName (hint, read_cstring i) - ) imports_data in - seek_rva ctx name_rva; - let name = read_cstring i in - { - imp_name = name; - imp_imports = imports; - } - ) tables - -let has_clr_header ctx = match get_dir ClrRuntimeHeader ctx with - | 0l,_ | _,0l -> - false - | _ -> - true - -let read_clr_header ctx = match get_dir ClrRuntimeHeader ctx with - | 0l,_ | _,0l -> - error "This PE file does not have managed content" - | rva,size -> - seek_rva ctx rva; - let i = ctx.r.i in - let cb = read_i32 i in - let major = read_ui16 i in - let minor = read_ui16 i in - let read_tbl i = - let rva = read_rva i in - let size = read_real_i32 i in - rva,size - in - let meta = read_tbl i in - let corflags = clr_flags_of_int (read_i32 i) in - let entry_point = read_rva i in - let res = read_tbl i in - let clrsig = read_tbl i in - let codeman = read_tbl i in - let vtable_fix = read_tbl i in - let export_addr = read_tbl i in - { - clr_cb = cb; - clr_major = major; - clr_minor = minor; - clr_meta = meta; - clr_flags = corflags; - clr_entry_point = entry_point; - clr_res = res; - clr_sig = clrsig; - clr_codeman = codeman; - clr_vtable_fix = vtable_fix; - clr_export_address = export_addr; - } - -let read r = - let i = r.i in - if read i <> 'M' || read i <> 'Z' then - error "MZ magic header not found: Is the target file really a PE?"; - seek r 0x3c; - let pe_sig_offset = read_i32 i in - seek r pe_sig_offset; - if really_nread_string i 4 <> "PE\x00\x00" then - error "Invalid PE header signature: PE expected"; - let header = read_coff_header i in - let pe_header = read_pe_header r header in - { - r = r; - pe_header = pe_header; - read_word = read_word (pe_header.pe_magic = P64); - } diff --git a/libs/ilib/peWriter.ml b/libs/ilib/peWriter.ml deleted file mode 100644 index afc672386dc..00000000000 --- a/libs/ilib/peWriter.ml +++ /dev/null @@ -1,160 +0,0 @@ -(* - * This file is part of ilLib - * Copyright (c)2004-2013 Haxe Foundation - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA - *) - -open PeData;; -open IO;; -open ExtString;; -open ExtList;; - -exception Error_message of string - -let error msg = raise (Error_message msg) - -type 'a writer_ctx = { - out : 'a IO.output; -} - -let int_of_machine_type t = match t with - | TUnknown -> 0x0 (* 0 - unmanaged PE files only *) - | Ti386 -> 0x014c (* 0x014c - i386 *) - | TR3000 -> 0x0162 (* 0x0162 - R3000 MIPS Little Endian *) - | TR4000 -> 0x0166 (* 0x0166 - R4000 MIPS Little Endian *) - | TR10000 -> 0x0168 (* 0x0168 - R10000 MIPS Little Endian *) - | TWCeMipsV2 -> 0x0169 (* 0x0169 - MIPS Litlte Endian running MS Windows CE 2 *) - | TAlpha -> 0x0184 (* 0x0184 - Alpha AXP *) - | TSh3 -> 0x01a2 (* 0x01a2 - SH3 Little Endian *) - | TSh3Dsp -> 0x01a3 (* 0x01a3 SH3DSP Little Endian *) - | TSh3e -> 0x01a4 (* 0x01a4 SH3E Little Endian *) - | TSh4 -> 0x01a6 (* 0x01a6 SH4 Little Endian *) - | TSh5 -> 0x01a8 - | TArm -> 0x01c0 (* 0x1c0 ARM Little Endian *) - | TArmN -> 0x01c4 (* 0x1c0 ARM Little Endian *) - | TArm64 -> 0xaa64 (* 0x1c0 ARM Little Endian *) - | TEbc -> 0xebc - | TThumb -> 0x01c2 (* 0x1c2 ARM processor with Thumb decompressor *) - | TAm33 -> 0x01d3 (* 0x1d3 AM33 processor *) - | TPowerPC -> 0x01f0 (* 0x01f0 IBM PowerPC Little Endian *) - | TPowerPCFP -> 0x01f1 (* 0x01f1 IBM PowerPC with FPU *) - | TItanium64 -> 0x0200 (* 0x0200 Intel IA64 (Itanium( *) - | TMips16 -> 0x0266 (* 0x0266 MIPS *) - | TAlpha64 -> 0x0284 (* 0x0284 Alpha AXP64 *) - | TMipsFpu -> 0x0366 (* 0x0366 MIPS with FPU *) - | TMipsFpu16 -> 0x0466 (* 0x0466 MIPS16 with FPU *) - | TTriCore -> 0x0520 (* 0x0520 Infineon *) - | TAmd64 -> 0x8664 (* 0x8664 AMD x64 and Intel E64T *) - | TM32R -> 0x9041 (* 0x9041 M32R *) - | TOSXAmd64 -> 0xC020 (* 0xC020 = 0x8664 xor 0x4644 OSX AMD x64 *) - | TLinuxAmd64 -> 0xFD1D (* 0xFD1D = 0x8664 xor 0x7B79 Linux AMD x64 *) - -let int_of_coff_props props = List.fold_left (fun acc prop -> - (match prop with - | RelocsStripped -> 0x1 (* 0x1 *) - | ExecutableImage -> 0x2 (* 0x2 *) - | LineNumsStripped -> 0x4 (* 0x4 *) - | LocalSymsStripped -> 0x8 (* 0x8 *) - | AgressiveWsTrim -> 0x10 (* 0x10 *) - | LargeAddressAware -> 0x20 (* 0x20 *) - | BytesReversedLO -> 0x80 (* 0x80 *) - | Machine32Bit -> 0x100 (* 0x100 *) - | DebugStripped -> 0x200 (* 0x200 *) - | RemovableRunFromSwap -> 0x400 (* 0x400 *) - | NetRunFromSwap -> 0x800 (* 0x800 *) - | FileSystem -> 0x1000 (* 0x1000 *) - | FileDll -> 0x2000 (* 0x2000 *) - | UpSystemOnly -> 0x4000 (* 0x4000 *) - | BytesReversedHI -> 0x8000 (* 0x8000 *) - ) lor acc - ) 0 props - -let int32_of_section_prop props = List.fold_left (fun acc prop -> - Int32.logor (match prop with - | SNoPad -> 0x8l (* 0x8 *) - | SHasCode -> 0x20l (* 0x20 *) - | SHasIData -> 0x40l (* 0x40 *) - | SHasData -> 0x80l (* 0x80 *) - | SHasLinkInfo -> 0x200l (* 0x200 *) - | SLinkRemove -> 0x1000l (* 0x1000 *) - | SGlobalRel -> 0x8000l (* 0x8000 *) - | SHas16BitMem -> 0x20000l (* 0x20000 *) - | SAlign1Bytes -> 0x100000l (* 0x100000 *) - | SAlign2Bytes -> 0x200000l (* 0x200000 *) - | SAlign4Bytes -> 0x300000l (* 0x300000 *) - | SAlign8Bytes -> 0x400000l (* 0x400000 *) - | SAlign16Bytes -> 0x500000l (* 0x500000 *) - | SAlign32Bytes -> 0x600000l (* 0x600000 *) - | SAlign64Bytes -> 0x700000l (* 0x700000 *) - | SAlign128Bytes -> 0x800000l (* 0x800000 *) - | SAlign256Bytes -> 0x900000l (* 0x900000 *) - | SAlign512Bytes -> 0xA00000l (* 0xA00000 *) - | SAlign1024Bytes -> 0xB00000l (* 0xB00000 *) - | SAlign2048Bytes -> 0xC00000l (* 0xC00000 *) - | SAlign4096Bytes -> 0xD00000l (* 0xD00000 *) - | SAlign8192Bytes -> 0xE00000l (* 0xE00000 *) - | SHasExtRelocs -> 0x1000000l (* 0x1000000 *) - | SCanDiscard -> 0x02000000l (* 0x02000000 *) - | SNotCached -> 0x04000000l (* 0x04000000 *) - | SNotPaged -> 0x08000000l (* 0x08000000 *) - | SShared -> 0x10000000l (* 0x10000000 *) - | SExec -> 0x20000000l (* 0x20000000 *) - | SRead -> 0x40000000l (* 0x40000000 *) - | SWrite -> 0x80000000l (* 0x80000000 *) - ) acc - ) 0l props - -let int_of_pe_magic m = match m with - | P32 -> 0x10b - | PRom -> 0x107 - | P64 -> 0x20b - -let int_of_subsystem s = match s with - | SUnknown -> 0 (* 0 *) - | SNative -> 1 (* 1 *) - | SWGui -> 2 (* 2 *) - | SWCui -> 3 (* 3 *) - | SPCui -> 7 (* 7 *) - | SWCeGui -> 9 (* 9 *) - | SEfi -> 10 (* 10 *) - | SEfiBoot -> 11 (* 11 *) - | SEfiRuntime -> 12 (* 12 *) - | SEfiRom -> 13 (* 13 *) - | SXbox -> 14 (* 14 *) - -let int_of_dll_props props = List.fold_left (fun acc prop -> - (match prop with - | DDynamicBase -> 0x0040 (* 0x0040 *) - | DForceIntegrity -> 0x0080 (* 0x0080 *) - | DNxCompat -> 0x0100 (* 0x0100 *) - | DNoIsolation -> 0x0200 (* 0x0200 *) - | DNoSeh -> 0x0400 (* 0x0400 *) - | DNoBind -> 0x0800 (* 0x0800 *) - | DWdmDriver -> 0x2000 (* 0x2000 *) - | DTerminalServer -> 0x8000 (* 0x8000 *) - ) lor acc - ) 0 props - -let int_of_clr_flags props = List.fold_left (fun acc prop -> - (match prop with - | FIlOnly -> 0x1 (* 0x1 *) - | F32BitRequired -> 0x2 (* 0x2 *) - | FIlLibrary -> 0x4 (* 0x4 *) - | FSigned -> 0x8 (* 0x8 *) - | FNativeEntry -> 0x10 (* 0x10 *) - | FTrackDebug -> 0x10000 (* 0x10000 *) - ) lor acc - ) 0 props diff --git a/libs/javalib/Makefile b/libs/javalib/Makefile deleted file mode 100644 index 2e7ddd22d8f..00000000000 --- a/libs/javalib/Makefile +++ /dev/null @@ -1,22 +0,0 @@ -OCAMLOPT=ocamlopt -OCAMLC=ocamlc -SRC=jData.ml jReader.ml jWriter.ml - -all: bytecode native - -native: javalib.cmxa -bytecode: javalib.cma - -javalib.cmxa: $(SRC) - ocamlfind $(OCAMLOPT) -g -package extlib -safe-string -a -o javalib.cmxa $(SRC) - -javalib.cma: $(SRC) - ocamlfind $(OCAMLC) -g -package extlib -safe-string -a -o javalib.cma $(SRC) - -clean: - rm -rf javalib.cmxa javalib.cma javalib.lib javalib.a $(wildcard *.cmx) $(wildcard *.obj) $(wildcard *.o) $(wildcard *.cmi) $(wildcard *.cmo) - -.PHONY: all bytecode native clean - -Makefile: ; -$(SRC): ; diff --git a/libs/javalib/dune b/libs/javalib/dune deleted file mode 100644 index 25c48591409..00000000000 --- a/libs/javalib/dune +++ /dev/null @@ -1,13 +0,0 @@ -(include_subdirs no) - -(env - (_ - (flags (-w -50)) - ) -) - -(library - (name javalib) - (libraries extlib) - (wrapped false) -) diff --git a/libs/javalib/jData.ml b/libs/javalib/jData.ml deleted file mode 100644 index 52c779e25bf..00000000000 --- a/libs/javalib/jData.ml +++ /dev/null @@ -1,267 +0,0 @@ -(* - * This file is part of JavaLib - * Copyright (c)2004-2012 Nicolas Cannasse and Caue Waneck - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA - *) - -type jpath = (string list) * string - -type jversion = int * int (* minor + major *) - -(** unqualified names cannot have the characters '.', ';', '[' or '/' *) -type unqualified_name = string - -type jwildcard = - | WExtends (* + *) - | WSuper (* - *) - | WNone - -type jtype_argument = - | TType of jwildcard * jsignature - | TAny (* * *) - -and jsignature = - | TByte (* B *) - | TChar (* C *) - | TDouble (* D *) - | TFloat (* F *) - | TInt (* I *) - | TLong (* J *) - | TShort (* S *) - | TBool (* Z *) - | TObject of jpath * jtype_argument list (* L Classname *) - | TObjectInner of (string list) * (string * jtype_argument list) list (* L Classname ClassTypeSignatureSuffix *) - | TArray of jsignature * int option (* [ *) - | TMethod of jmethod_signature (* ( *) - | TTypeParameter of string (* T *) - -(* ( jsignature list ) ReturnDescriptor (| V | jsignature) *) -and jmethod_signature = jsignature list * jsignature option - -(* InvokeDynamic-specific: Method handle *) -type reference_type = - | RGetField (* constant must be ConstField *) - | RGetStatic (* constant must be ConstField *) - | RPutField (* constant must be ConstField *) - | RPutStatic (* constant must be ConstField *) - | RInvokeVirtual (* constant must be Method *) - | RInvokeStatic (* constant must be Method *) - | RInvokeSpecial (* constant must be Method *) - | RNewInvokeSpecial (* constant must be Method with name *) - | RInvokeInterface (* constant must be InterfaceMethod *) - -(* TODO *) -type bootstrap_method = int - -type jconstant = - (** references a class or an interface - jpath must be encoded as StringUtf8 *) - | ConstClass of jpath (* tag = 7 *) - (** field reference *) - | ConstField of (jpath * unqualified_name * jsignature) (* tag = 9 *) - (** method reference; string can be special "" and "" values *) - | ConstMethod of (jpath * unqualified_name * jmethod_signature) (* tag = 10 *) - (** interface method reference *) - | ConstInterfaceMethod of (jpath * unqualified_name * jmethod_signature) (* tag = 11 *) - (** constant values *) - | ConstString of string (* tag = 8 *) - | ConstInt of int32 (* tag = 3 *) - | ConstFloat of float (* tag = 4 *) - | ConstLong of int64 (* tag = 5 *) - | ConstDouble of float (* tag = 6 *) - (** name and type: used to represent a field or method, without indicating which class it belongs to *) - | ConstNameAndType of unqualified_name * jsignature - (** UTF8 encoded strings. Note that when reading/writing, take into account Utf8 modifications of java *) - (* (http://docs.oracle.com/javase/specs/jvms/se7/html/jvms-4.html#jvms-4.4.7) *) - | ConstUtf8 of string - (** invokeDynamic-specific *) - | ConstMethodHandle of (reference_type * jconstant) (* tag = 15 *) - | ConstMethodType of jmethod_signature (* tag = 16 *) - | ConstDynamic of (bootstrap_method * unqualified_name * jsignature) (* tag = 17 *) - | ConstInvokeDynamic of (bootstrap_method * unqualified_name * jsignature) (* tag = 18 *) - | ConstModule of unqualified_name (* tag = 19 *) - | ConstPackage of unqualified_name (* tag = 20 *) - | ConstUnusable - -type jaccess_flag = - | JPublic (* 0x0001 *) - | JPrivate (* 0x0002 *) - | JProtected (* 0x0004 *) - | JStatic (* 0x0008 *) - | JFinal (* 0x0010 *) - | JSynchronized (* 0x0020 *) - | JVolatile (* 0x0040 *) - | JTransient (* 0x0080 *) - (** added if created by the compiler *) - | JSynthetic (* 0x1000 *) - | JEnum (* 0x4000 *) - | JUnusable (* should not be present *) - (** class flags *) - | JSuper (* 0x0020 *) - | JInterface (* 0x0200 *) - | JAbstract (* 0x0400 *) - | JAnnotation (* 0x2000 *) - | JModule (* 0x8000 *) - (** method flags *) - | JBridge (* 0x0040 *) - | JVarArgs (* 0x0080 *) - | JNative (* 0x0100 *) - | JStrict (* 0x0800 *) - -type jaccess = jaccess_flag list - -(* type parameter name, extends signature, implements signatures *) -type jtypes = (string * jsignature option * jsignature list) list - -type jannotation = { - ann_type : jsignature; - ann_elements : (string * jannotation_value) list; -} - -and jannotation_value = - | ValConst of jsignature * jconstant (* B, C, D, E, F, I, J, S, Z, s *) - | ValEnum of jsignature * string (* e *) - | ValClass of jsignature (* c *) (* V -> Void *) - | ValAnnotation of jannotation (* @ *) - | ValArray of jannotation_value list (* [ *) - -type jlocal = { - ld_start_pc : int; - ld_length : int; - ld_name : string; - ld_descriptor : string; - ld_index : int; -} - -type jattribute = - | AttrDeprecated - | AttrVisibleAnnotations of jannotation list - | AttrInvisibleAnnotations of jannotation list - | AttrLocalVariableTable of jlocal list - | AttrMethodParameters of (string * int) list - | AttrUnknown of string * string - -type jcode = jattribute list (* TODO *) - -type jfield_kind = - | JKField - | JKMethod - -type jfield = { - jf_name : string; - jf_kind : jfield_kind; - (* signature, as used by the vm *) - jf_vmsignature : jsignature; - (* actual signature, as used in java code *) - jf_signature : jsignature; - jf_throws : jsignature list; - jf_types : jtypes; - jf_flags : jaccess; - jf_attributes : jattribute list; - jf_constant : jconstant option; - jf_code : jcode option; -} - -type jclass = { - cversion : jversion; - cpath : jpath; - csuper : jsignature; - cflags : jaccess; - cinterfaces : jsignature list; - cfields : jfield list; - cmethods : jfield list; - cattributes : jattribute list; - - cinner_types : (jpath * jpath option * string option * jaccess) list; - ctypes : jtypes; -} - -(* reading/writing *) -type utf8ref = int -type classref = int -type nametyperef = int -type dynref = int -type bootstrapref = int - -type jconstant_raw = - | KClass of utf8ref (* 7 *) - | KFieldRef of (classref * nametyperef) (* 9 *) - | KMethodRef of (classref * nametyperef) (* 10 *) - | KInterfaceMethodRef of (classref * nametyperef) (* 11 *) - | KString of utf8ref (* 8 *) - | KInt of int32 (* 3 *) - | KFloat of float (* 4 *) - | KLong of int64 (* 5 *) - | KDouble of float (* 6 *) - | KNameAndType of (utf8ref * utf8ref) (* 12 *) - | KUtf8String of string (* 1 *) - | KMethodHandle of (reference_type * dynref) (* 15 *) - | KMethodType of utf8ref (* 16 *) - | KDynamic of (bootstrapref * nametyperef) (* 17 *) - | KInvokeDynamic of (bootstrapref * nametyperef) (* 18 *) - | KModule of utf8ref (* 19 *) - | KPackage of utf8ref (* 20 *) - | KUnusable - -(* jData debugging *) -let is_override_attrib = (function - (* TODO: pass anotations as @:meta *) - | AttrVisibleAnnotations ann -> - List.exists (function - | { ann_type = TObject( (["java";"lang"], "Override"), [] ) } -> - true - | _ -> false - ) ann - | _ -> false - ) - -let is_override field = - List.exists is_override_attrib field.jf_attributes - -let path_s = function - | (pack,name) -> String.concat "." (pack @ [name]) - -let rec s_sig = function - | TByte (* B *) -> "byte" - | TChar (* C *) -> "char" - | TDouble (* D *) -> "double" - | TFloat (* F *) -> "float" - | TInt (* I *) -> "int" - | TLong (* J *) -> "long" - | TShort (* S *) -> "short" - | TBool (* Z *) -> "bool" - | TObject(path,args) -> path_s path ^ s_args args - | TObjectInner (sl, sjargl) -> String.concat "." sl ^ "." ^ (String.concat "." (List.map (fun (s,arg) -> s ^ s_args arg) sjargl)) - | TArray (s,i) -> s_sig s ^ "[" ^ (match i with | None -> "" | Some i -> string_of_int i) ^ "]" - | TMethod (sigs, sopt) -> (match sopt with | None -> "" | Some s -> s_sig s ^ " ") ^ "(" ^ String.concat ", " (List.map s_sig sigs) ^ ")" - | TTypeParameter s -> s - -and s_args = function - | [] -> "" - | args -> "<" ^ String.concat ", " (List.map (fun t -> - match t with - | TAny -> "*" - | TType (wc, s) -> - (match wc with - | WNone -> "" - | WExtends -> "+" - | WSuper -> "-") ^ - (s_sig s)) - args) ^ ">" - -let s_field f = (if is_override f then "override " else "") ^ s_sig f.jf_signature ^ " " ^ f.jf_name - -let s_fields fs = "{ \n\t" ^ String.concat "\n\t" (List.map s_field fs) ^ "\n}" - diff --git a/libs/javalib/jReader.ml b/libs/javalib/jReader.ml deleted file mode 100644 index 6a3a4706e4a..00000000000 --- a/libs/javalib/jReader.ml +++ /dev/null @@ -1,646 +0,0 @@ -(* - * This file is part of JavaLib - * Copyright (c)2004-2012 Nicolas Cannasse and Caue Waneck - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA - *) -open JData;; -open IO.BigEndian;; -open ExtString;; -open ExtList;; - -exception Error_message of string - -let error msg = raise (Error_message msg) - -let get_reference_type i constid = - match i with - | 1 -> RGetField - | 2 -> RGetStatic - | 3 -> RPutField - | 4 -> RPutStatic - | 5 -> RInvokeVirtual - | 6 -> RInvokeStatic - | 7 -> RInvokeSpecial - | 8 -> RNewInvokeSpecial - | 9 -> RInvokeInterface - | _ -> error (string_of_int constid ^ ": Invalid reference type " ^ string_of_int i) - -let parse_constant max idx ch = - let cid = IO.read_byte ch in - let error() = error (string_of_int idx ^ ": Invalid constant " ^ string_of_int cid) in - let index() = - let n = read_ui16 ch in - if n = 0 || n >= max then error(); - n - in - match cid with - | 7 -> - KClass (index()) - | 9 -> - let n1 = index() in - let n2 = index() in - KFieldRef (n1,n2) - | 10 -> - let n1 = index() in - let n2 = index() in - KMethodRef (n1,n2) - | 11 -> - let n1 = index() in - let n2 = index() in - KInterfaceMethodRef (n1,n2) - | 8 -> - KString (index()) - | 3 -> - KInt (read_real_i32 ch) - | 4 -> - let f = Int32.float_of_bits (read_real_i32 ch) in - KFloat f - | 5 -> - KLong (read_i64 ch) - | 6 -> - KDouble (read_double ch) - | 12 -> - let n1 = index() in - let n2 = index() in - KNameAndType (n1, n2) - | 1 -> - let len = read_ui16 ch in - let str = IO.nread_string ch len in - (* TODO: correctly decode modified UTF8 *) - KUtf8String str - | 15 -> - let reft = get_reference_type (IO.read_byte ch) idx in - let dynref = index() in - KMethodHandle (reft, dynref) - | 16 -> - KMethodType (index()) - | 17 -> - let bootstrapref = read_ui16 ch in (* not index *) - let nametyperef = index() in - KDynamic (bootstrapref, nametyperef) - | 18 -> - let bootstrapref = read_ui16 ch in (* not index *) - let nametyperef = index() in - KInvokeDynamic (bootstrapref, nametyperef) - | 19 -> - KModule (index()) - | 20 -> - KPackage (index()) - | n -> - error() - -let expand_path s = - let rec loop remaining acc = - match remaining with - | name :: [] -> List.rev acc, name - | v :: tl -> loop tl (v :: acc) - | _ -> assert false - in - loop (String.nsplit s "/") [] - -let rec parse_type_parameter_part s = - match s.[0] with - | '*' -> TAny, 1 - | c -> - let wildcard, i = match c with - | '+' -> WExtends, 1 - | '-' -> WSuper, 1 - | _ -> WNone, 0 - in - let jsig, l = parse_signature_part (String.sub s i (String.length s - 1)) in - (TType (wildcard, jsig), l + i) - -and parse_signature_part s = - let len = String.length s in - if len = 0 then raise Exit; - match s.[0] with - | 'B' -> TByte, 1 - | 'C' -> TChar, 1 - | 'D' -> TDouble, 1 - | 'F' -> TFloat, 1 - | 'I' -> TInt, 1 - | 'J' -> TLong, 1 - | 'S' -> TShort, 1 - | 'Z' -> TBool, 1 - | 'L' -> - (try - let orig_s = s in - let rec loop start i acc = - match s.[i] with - | '/' -> loop (i + 1) (i + 1) (String.sub s start (i - start) :: acc) - | ';' | '.' -> List.rev acc, (String.sub s start (i - start)), [], (i) - | '<' -> - let name = String.sub s start (i - start) in - let rec loop_params i acc = - let s = String.sub s i (len - i) in - match s.[0] with - | '>' -> List.rev acc, i + 1 - | _ -> - let tp, l = parse_type_parameter_part s in - loop_params (l + i) (tp :: acc) - in - let params, _end = loop_params (i + 1) [] in - List.rev acc, name, params, (_end) - | _ -> loop start (i+1) acc - in - let pack, name, params, _end = loop 1 1 [] in - let rec loop_inner i acc = - match s.[i] with - | '.' -> - let pack, name, params, _end = loop (i+1) (i+1) [] in - if pack <> [] then error ("Inner types must not define packages. For '" ^ orig_s ^ "'."); - loop_inner _end ( (name,params) :: acc ) - | ';' -> List.rev acc, i + 1 - | c -> error ("End of complex type signature expected after type parameter. Got '" ^ Char.escaped c ^ "' for '" ^ orig_s ^ "'." ); - in - let inners, _end = loop_inner _end [] in - match inners with - | [] -> TObject((pack,name), params), _end - | _ -> TObjectInner( pack, (name,params) :: inners ), _end - with - Invalid_string -> raise Exit) - | '[' -> - let p = ref 1 in - while !p < String.length s && s.[!p] >= '0' && s.[!p] <= '9' do - incr p; - done; - let size = (if !p > 1 then Some (int_of_string (String.sub s 1 (!p - 1))) else None) in - let s , l = parse_signature_part (String.sub s !p (String.length s - !p)) in - TArray (s,size) , l + !p - | '(' -> - let p = ref 1 in - let args = ref [] in - while !p < String.length s && s.[!p] <> ')' do - let a , l = parse_signature_part (String.sub s !p (String.length s - !p)) in - args := a :: !args; - p := !p + l; - done; - incr p; - if !p >= String.length s then raise Exit; - let ret , l = (match s.[!p] with 'V' -> None , 1 | _ -> - let s, l = parse_signature_part (String.sub s !p (String.length s - !p)) in - Some s, l - ) in - TMethod (List.rev !args,ret) , !p + l - | 'T' -> - (try - let s1 , _ = String.split s ";" in - let len = String.length s1 in - TTypeParameter (String.sub s1 1 (len - 1)) , len + 1 - with - Invalid_string -> raise Exit) - | _ -> - raise Exit - -let parse_signature s = - try - let sign , l = parse_signature_part s in - if String.length s <> l then raise Exit; - sign - with - Exit -> error ("Invalid signature '" ^ s ^ "'") - -let parse_method_signature s = - match parse_signature s with - | (TMethod m) -> m - | _ -> error ("Unexpected signature '" ^ s ^ "'. Expecting method") - -let parse_formal_type_params s = - match s.[0] with - | '<' -> - let rec read_id i = - match s.[i] with - | ':' | '>' -> i - | _ -> read_id (i + 1) - in - let len = String.length s in - let rec parse_params idx acc = - let idi = read_id (idx + 1) in - let id = String.sub s (idx + 1) (idi - idx - 1) in - (* next must be a : *) - (match s.[idi] with | ':' -> () | _ -> error ("Invalid formal type signature character: " ^ Char.escaped s.[idi] ^ " ; from " ^ s)); - let ext, l = match s.[idi + 1] with - | ':' | '>' -> None, idi + 1 - | _ -> - let sgn, l = parse_signature_part (String.sub s (idi + 1) (len - idi - 1)) in - Some sgn, l + idi + 1 - in - let rec loop idx acc = - match s.[idx] with - | ':' -> - let ifacesig, ifacei = parse_signature_part (String.sub s (idx + 1) (len - idx - 1)) in - loop (idx + ifacei + 1) (ifacesig :: acc) - | _ -> acc, idx - in - let ifaces, idx = loop l [] in - let acc = (id, ext, ifaces) :: acc in - if s.[idx] = '>' then List.rev acc, idx + 1 else parse_params (idx - 1) acc - in - parse_params 0 [] - | _ -> [], 0 - -let parse_throws s = - let len = String.length s in - let rec loop idx acc = - if idx > len then raise Exit - else if idx = len then acc, idx - else match s.[idx] with - | '^' -> - let tsig, l = parse_signature_part (String.sub s (idx+1) (len - idx - 1)) in - loop (idx + l + 1) (tsig :: acc) - | _ -> acc, idx - in - loop 0 [] - -let parse_complete_method_signature s = - try - let len = String.length s in - let tparams, i = parse_formal_type_params s in - let sign, l = parse_signature_part (String.sub s i (len - i)) in - let throws, l2 = parse_throws (String.sub s (i+l) (len - i - l)) in - if (i + l + l2) <> len then raise Exit; - - match sign with - | TMethod msig -> tparams, msig, throws - | _ -> raise Exit - with - Exit -> error ("Invalid method extended signature '" ^ s ^ "'") - - -let rec expand_constant consts i = - let unexpected i = error (string_of_int i ^ ": Unexpected constant type") in - let expand_path n = match Array.get consts n with - | KUtf8String s -> expand_path s - | _ -> unexpected n - in - let expand_cls n = match expand_constant consts n with - | ConstClass p -> p - | _ -> unexpected n - in - let expand_nametype n = match expand_constant consts n with - | ConstNameAndType (s,jsig) -> s, jsig - | _ -> unexpected n - in - let expand_string n = match Array.get consts n with - | KUtf8String s -> s - | _ -> unexpected n - in - let expand_nametype_m n = match expand_nametype n with - | (n, TMethod m) -> n, m - | _ -> unexpected n - in - let expand ncls nt = match expand_cls ncls, expand_nametype nt with - | path, (n, m) -> path, n, m - in - let expand_m ncls nt = match expand_cls ncls, expand_nametype_m nt with - | path, (n, m) -> path, n, m - in - - match Array.get consts i with - | KClass utf8ref -> - ConstClass (expand_path utf8ref) - | KFieldRef (classref, nametyperef) -> - ConstField (expand classref nametyperef) - | KMethodRef (classref, nametyperef) -> - ConstMethod (expand_m classref nametyperef) - | KInterfaceMethodRef (classref, nametyperef) -> - ConstInterfaceMethod (expand_m classref nametyperef) - | KString utf8ref -> - ConstString (expand_string utf8ref) - | KInt i32 -> - ConstInt i32 - | KFloat f -> - ConstFloat f - | KLong i64 -> - ConstLong i64 - | KDouble d -> - ConstDouble d - | KNameAndType (n, t) -> - ConstNameAndType(expand_string n, parse_signature (expand_string t)) - | KUtf8String s -> - ConstUtf8 s (* TODO: expand UTF8 characters *) - | KMethodHandle (reference_type, dynref) -> - ConstMethodHandle (reference_type, expand_constant consts dynref) - | KMethodType utf8ref -> - ConstMethodType (parse_method_signature (expand_string utf8ref)) - | KDynamic(bootstrapref, nametyperef) -> - let n, t = expand_nametype nametyperef in - ConstDynamic(bootstrapref, n, t) - | KInvokeDynamic (bootstrapref, nametyperef) -> - let n, t = expand_nametype nametyperef in - ConstInvokeDynamic(bootstrapref, n, t) - | KModule n -> - ConstModule (expand_string n) - | KPackage n -> - ConstPackage (expand_string n) - | KUnusable -> - ConstUnusable - -let parse_access_flags ch all_flags = - let fl = read_ui16 ch in - let flags = ref [] in - List.iteri (fun fbit f -> - if fl land (1 lsl fbit) <> 0 then begin - flags := f :: !flags; - if f = JUnusable then error ("Unusable flag: " ^ string_of_int fl) - end - ) all_flags; - (*if fl land (0x4000 - (1 lsl !fbit)) <> 0 then error ("Invalid access flags " ^ string_of_int fl);*) - !flags - -let get_constant c n = - if n < 1 || n >= Array.length c then error ("Invalid constant index " ^ string_of_int n); - match c.(n) with - | ConstUnusable -> error "Unusable constant index"; - | x -> x - -let get_class consts ch = - match get_constant consts (read_ui16 ch) with - | ConstClass n -> n - | _ -> error "Invalid class index" - -let get_string consts ch = - let i = read_ui16 ch in - match get_constant consts i with - | ConstUtf8 s -> s - | _ -> error ("Invalid string index " ^ string_of_int i) - -let rec parse_element_value consts ch = - let tag = IO.read_byte ch in - match Char.chr tag with - | 'B' | 'C' | 'D' | 'F' | 'I' | 'J' | 'S' | 'Z' | 's' -> - let jsig = match (Char.chr tag) with - | 's' -> - TObject( (["java";"lang"],"String"), [] ) - | tag -> - fst (parse_signature_part (Char.escaped tag)) - in - ValConst(jsig, get_constant consts (read_ui16 ch)) - | 'e' -> - let path = parse_signature (get_string consts ch) in - let name = get_string consts ch in - ValEnum (path, name) - | 'c' -> - let name = get_string consts ch in - let jsig = if name = "V" then - TObject(([], "Void"), []) - else - parse_signature name - in - ValClass jsig - | '@' -> - ValAnnotation (parse_annotation consts ch) - | '[' -> - let num_vals = read_ui16 ch in - ValArray (List.init (num_vals) (fun _ -> parse_element_value consts ch)) - | tag -> error ("Invalid element value: '" ^ Char.escaped tag ^ "'") - -and parse_ann_element consts ch = - let name = get_string consts ch in - let element_value = parse_element_value consts ch in - name, element_value - -and parse_annotation consts ch = - let anntype = parse_signature (get_string consts ch) in - let count = read_ui16 ch in - { - ann_type = anntype; - ann_elements = List.init count (fun _ -> parse_ann_element consts ch) - } - -let parse_attribute on_special consts ch = - let aname = get_string consts ch in - let error() = error ("Malformed attribute " ^ aname) in - let alen = read_i32 ch in - match aname with - | "Deprecated" -> - if alen <> 0 then error(); - Some (AttrDeprecated) - | "LocalVariableTable" -> - let len = read_ui16 ch in - let locals = List.init len (fun _ -> - let start_pc = read_ui16 ch in - let length = read_ui16 ch in - let name = get_string consts ch in - let descriptor = get_string consts ch in - let index = read_ui16 ch in - { - ld_start_pc = start_pc; - ld_length = length; - ld_name = name; - ld_descriptor = descriptor; - ld_index = index - } - ) in - Some (AttrLocalVariableTable locals) - | "MethodParameters" -> - let len = IO.read_byte ch in - let parameters = List.init len (fun _ -> - let name = get_string consts ch in - let flags = read_ui16 ch in - (name,flags) - ) in - Some (AttrMethodParameters parameters) - | "RuntimeVisibleAnnotations" -> - let anncount = read_ui16 ch in - Some (AttrVisibleAnnotations (List.init anncount (fun _ -> parse_annotation consts ch))) - | "RuntimeInvisibleAnnotations" -> - let anncount = read_ui16 ch in - Some (AttrInvisibleAnnotations (List.init anncount (fun _ -> parse_annotation consts ch))) - | _ -> - let do_default () = - Some (AttrUnknown (aname,IO.nread_string ch alen)) - in - match on_special with - | None -> do_default() - | Some fn -> fn consts ch aname alen do_default - -let parse_attributes ?on_special consts ch count = - let rec loop i acc = - if i >= count then List.rev acc - else match parse_attribute on_special consts ch with - | None -> loop (i + 1) acc - | Some attrib -> loop (i + 1) (attrib :: acc) - in - loop 0 [] - -let parse_field kind consts ch = - let all_flags = match kind with - | JKField -> - [JPublic; JPrivate; JProtected; JStatic; JFinal; JUnusable; JVolatile; JTransient; JSynthetic; JEnum] - | JKMethod -> - [JPublic; JPrivate; JProtected; JStatic; JFinal; JSynchronized; JBridge; JVarArgs; JNative; JUnusable; JAbstract; JStrict; JSynthetic] - in - let acc = ref (parse_access_flags ch all_flags) in - let name = get_string consts ch in - let sign = parse_signature (get_string consts ch) in - - let jsig = ref sign in - let throws = ref [] in - let types = ref [] in - let constant = ref None in - let code = ref None in - - let attrib_count = read_ui16 ch in - let attribs = parse_attributes ~on_special:(fun _ _ aname alen do_default -> - match kind, aname with - | JKField, "ConstantValue" -> - constant := Some (get_constant consts (read_ui16 ch)); - None - | JKField, "Synthetic" -> - if not (List.mem JSynthetic !acc) then acc := !acc @ [JSynthetic]; - None - | JKField, "Signature" -> - let s = get_string consts ch in - jsig := parse_signature s; - None - | JKMethod, "Code" -> - ignore(read_ui16 ch); (* max stack *) - ignore(read_ui16 ch); (* max locals *) - let len = read_i32 ch in - ignore(IO.nread_string ch len); (* code *) - let len = read_ui16 ch in - for i = 0 to len - 1 do - ignore(IO.nread_string ch 8); - done; (* exceptions *) - let attrib_count = read_ui16 ch in - let attribs = parse_attributes consts ch attrib_count in - code := Some attribs; - None - | JKMethod, "Exceptions" -> - let num = read_ui16 ch in - throws := List.init num (fun _ -> TObject(get_class consts ch,[])); - None - | JKMethod, "Signature" -> - let s = get_string consts ch in - let tp, sgn, thr = parse_complete_method_signature s in - if thr <> [] then throws := thr; - types := tp; - jsig := TMethod(sgn); - None - | _ -> do_default() - ) consts ch attrib_count in - { - jf_name = name; - jf_kind = kind; - (* signature, as used by the vm *) - jf_vmsignature = sign; - (* actual signature, as used in java code *) - jf_signature = !jsig; - jf_throws = !throws; - jf_types = !types; - jf_flags = !acc; - jf_attributes = attribs; - jf_constant = !constant; - jf_code = !code; - } - -let parse_class ch = - if read_real_i32 ch <> 0xCAFEBABEl then error "Invalid header"; - let minorv = read_ui16 ch in - let majorv = read_ui16 ch in - let constant_count = read_ui16 ch in - let const_big = ref true in - let consts = Array.init constant_count (fun idx -> - if !const_big then begin - const_big := false; - KUnusable - end else - let c = parse_constant constant_count idx ch in - (match c with KLong _ | KDouble _ -> const_big := true | _ -> ()); - c - ) in - let consts = Array.mapi (fun i _ -> expand_constant consts i) consts in - let flags = parse_access_flags ch [JPublic; JUnusable; JUnusable; JUnusable; JFinal; JSuper; JUnusable; JUnusable; JUnusable; JInterface; JAbstract; JUnusable; JSynthetic; JAnnotation; JEnum; JModule] in - let this = get_class consts ch in - let super_idx = read_ui16 ch in - let super = match super_idx with - | 0 -> TObject((["java";"lang"], "Object"), []); - | idx -> match get_constant consts idx with - | ConstClass path -> TObject(path,[]) - | _ -> error "Invalid super index" - in - let interfaces = List.init (read_ui16 ch) (fun _ -> TObject (get_class consts ch, [])) in - let fields = List.init (read_ui16 ch) (fun _ -> parse_field JKField consts ch) in - let methods = List.init (read_ui16 ch) (fun _ -> parse_field JKMethod consts ch) in - - let inner = ref [] in - let types = ref [] in - let super = ref super in - let interfaces = ref interfaces in - - let attribs = read_ui16 ch in - let attribs = parse_attributes ~on_special:(fun _ _ aname alen do_default -> - match aname with - | "InnerClasses" -> - let count = read_ui16 ch in - let classes = List.init count (fun _ -> - let inner_ci = get_class consts ch in - let outeri = read_ui16 ch in - let outer_ci = match outeri with - | 0 -> None - | _ -> match get_constant consts outeri with - | ConstClass n -> Some n - | _ -> error "Invalid class index" - in - - let inner_namei = read_ui16 ch in - let inner_name = match inner_namei with - | 0 -> None - | _ -> match get_constant consts inner_namei with - | ConstUtf8 s -> Some s - | _ -> error ("Invalid string index " ^ string_of_int inner_namei) - in - let flags = parse_access_flags ch [JPublic; JPrivate; JProtected; JStatic; JFinal; JUnusable; JUnusable; JUnusable; JUnusable; JInterface; JAbstract; JSynthetic; JAnnotation; JEnum] in - inner_ci, outer_ci, inner_name, flags - ) in - inner := classes; - None - | "Signature" -> - let s = get_string consts ch in - let formal, idx = parse_formal_type_params s in - types := formal; - let s = String.sub s idx (String.length s - idx) in - let len = String.length s in - let sup, idx = parse_signature_part s in - let rec loop idx acc = - if idx = len then - acc - else begin - let s = String.sub s idx (len - idx) in - let iface, i2 = parse_signature_part s in - loop (idx + i2) (iface :: acc) - end - in - interfaces := loop idx []; - super := sup; - None - | _ -> do_default() - ) consts ch attribs in - IO.close_in ch; - { - cversion = majorv, minorv; - cpath = this; - csuper = !super; - cflags = flags; - cinterfaces = !interfaces; - cfields = fields; - cmethods = methods; - cattributes = attribs; - cinner_types = !inner; - ctypes = !types; - } - diff --git a/libs/javalib/jWriter.ml b/libs/javalib/jWriter.ml deleted file mode 100644 index 6218d199383..00000000000 --- a/libs/javalib/jWriter.ml +++ /dev/null @@ -1,299 +0,0 @@ -(* - * This file is part of JavaLib - * Copyright (c)2004-2012 Nicolas Cannasse and Caue Waneck - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA - *) -open JData;; -open IO.BigEndian;; -open IO;; -open ExtString;; -open ExtList;; - -exception Writer_error_message of string - -type context = { - cpool : unit IO.output; - mutable ccount : int; - ch : string IO.output; - mutable constants : (jconstant,int) PMap.t; -} - -let error msg = raise (Writer_error_message msg) - -let get_reference_type i = - match i with - | RGetField -> 1 - | RGetStatic -> 2 - | RPutField -> 3 - | RPutStatic -> 4 - | RInvokeVirtual -> 5 - | RInvokeStatic -> 6 - | RInvokeSpecial -> 7 - | RNewInvokeSpecial -> 8 - | RInvokeInterface -> 9 - -let encode_path ctx (pack,name) = - String.concat "/" (pack @ [name]) - -let rec encode_param ctx ch param = - match param with - | TAny -> write_byte ch (Char.code '*') - | TType(w, s) -> - (match w with - | WExtends -> write_byte ch (Char.code '+') - | WSuper -> write_byte ch (Char.code '-') - | WNone -> ()); - encode_sig_part ctx ch s - -and encode_sig_part ctx ch jsig = match jsig with - | TByte -> write_byte ch (Char.code 'B') - | TChar -> write_byte ch (Char.code 'C') - | TDouble -> write_byte ch (Char.code 'D') - | TFloat -> write_byte ch (Char.code 'F') - | TInt -> write_byte ch (Char.code 'I') - | TLong -> write_byte ch (Char.code 'J') - | TShort -> write_byte ch (Char.code 'S') - | TBool -> write_byte ch (Char.code 'Z') - | TObject(path, params) -> - write_byte ch (Char.code 'L'); - write_string ch (encode_path ctx path); - if params <> [] then begin - write_byte ch (Char.code '<'); - List.iter (encode_param ctx ch) params; - write_byte ch (Char.code '>') - end; - write_byte ch (Char.code ';') - | TObjectInner(pack, inners) -> - write_byte ch (Char.code 'L'); - List.iter (fun p -> - write_string ch p; - write_byte ch (Char.code '/') - ) pack; - - let first = ref true in - List.iter (fun (name,params) -> - (if !first then first := false else write_byte ch (Char.code '.')); - write_string ch name; - if params <> [] then begin - write_byte ch (Char.code '<'); - List.iter (encode_param ctx ch) params; - write_byte ch (Char.code '>') - end; - ) inners; - write_byte ch (Char.code ';') - | TArray(s,size) -> - write_byte ch (Char.code '['); - (match size with - | Some size -> - write_string ch (string_of_int size); - | None -> ()); - encode_sig_part ctx ch s - | TMethod(args, ret) -> - write_byte ch (Char.code '('); - List.iter (encode_sig_part ctx ch) args; - (match ret with - | None -> write_byte ch (Char.code 'V') - | Some jsig -> encode_sig_part ctx ch jsig) - | TTypeParameter name -> - write_byte ch (Char.code 'T'); - write_string ch name; - write_byte ch (Char.code ';') - -let encode_sig ctx jsig = - let buf = IO.output_string() in - encode_sig_part ctx buf jsig; - close_out buf - -let write_utf8 ch s = - String.iter (fun c -> - let c = Char.code c in - if c = 0 then begin - write_byte ch 0xC0; - write_byte ch 0x80 - end else - write_byte ch c - ) s - -let rec const ctx c = - try - PMap.find c ctx.constants - with - | Not_found -> - let ret = ctx.ccount in - (match c with - (** references a class or an interface - jpath must be encoded as StringUtf8 *) - | ConstClass path -> (* tag = 7 *) - write_byte ctx.cpool 7; - write_ui16 ctx.cpool (const ctx (ConstUtf8 (encode_path ctx path))) - (** field reference *) - | ConstField (jpath, unqualified_name, jsignature) (* tag = 9 *) -> - write_byte ctx.cpool 9; - write_ui16 ctx.cpool (const ctx (ConstClass jpath)); - write_ui16 ctx.cpool (const ctx (ConstNameAndType (unqualified_name, jsignature))) - (** method reference; string can be special "" and "" values *) - | ConstMethod (jpath, unqualified_name, jmethod_signature) (* tag = 10 *) -> - write_byte ctx.cpool 10; - write_ui16 ctx.cpool (const ctx (ConstClass jpath)); - write_ui16 ctx.cpool (const ctx (ConstNameAndType (unqualified_name, TMethod jmethod_signature))) - (** interface method reference *) - | ConstInterfaceMethod (jpath, unqualified_name, jmethod_signature) (* tag = 11 *) -> - write_byte ctx.cpool 11; - write_ui16 ctx.cpool (const ctx (ConstClass jpath)); - write_ui16 ctx.cpool (const ctx (ConstNameAndType (unqualified_name, TMethod jmethod_signature))) - (** constant values *) - | ConstString s (* tag = 8 *) -> - write_byte ctx.cpool 8; - write_ui16 ctx.cpool (const ctx (ConstUtf8 s)) - | ConstInt i (* tag = 3 *) -> - write_byte ctx.cpool 3; - write_real_i32 ctx.cpool i - | ConstFloat f (* tag = 4 *) -> - write_byte ctx.cpool 4; - (match classify_float f with - | FP_normal | FP_subnormal | FP_zero -> - write_real_i32 ctx.cpool (Int32.bits_of_float f) - | FP_infinite when f > 0.0 -> - write_real_i32 ctx.cpool 0x7f800000l - | FP_infinite -> - write_real_i32 ctx.cpool 0xff800000l - | FP_nan -> - write_real_i32 ctx.cpool 0x7f800001l) - | ConstLong i (* tag = 5 *) -> - write_byte ctx.cpool 5; - write_i64 ctx.cpool i; - | ConstDouble d (* tag = 6 *) -> - write_byte ctx.cpool 6; - write_double ctx.cpool d; - ctx.ccount <- ctx.ccount + 1 - (** name and type: used to represent a field or method, without indicating which class it belongs to *) - | ConstNameAndType (unqualified_name, jsignature) -> - write_byte ctx.cpool 12; - write_ui16 ctx.cpool (const ctx (ConstUtf8 (unqualified_name))); - write_ui16 ctx.cpool (const ctx (ConstUtf8 (encode_sig ctx jsignature))) - (** UTF8 encoded strings. Note that when reading/writing, take into account Utf8 modifications of java *) - (* (http://docs.oracle.com/javase/specs/jvms/se7/html/jvms-4.html#jvms-4.4.7) *) - | ConstUtf8 s -> - write_byte ctx.cpool 1; - write_ui16 ctx.cpool (String.length s); - write_utf8 ctx.cpool s - (** invokeDynamic-specific *) - | ConstMethodHandle (reference_type, jconstant) (* tag = 15 *) -> - write_byte ctx.cpool 15; - write_byte ctx.cpool (get_reference_type reference_type); - write_ui16 ctx.cpool (const ctx jconstant) - | ConstMethodType jmethod_signature (* tag = 16 *) -> - write_byte ctx.cpool 16; - write_ui16 ctx.cpool (const ctx (ConstUtf8 (encode_sig ctx (TMethod jmethod_signature)))) - | ConstDynamic (bootstrap_method, unqualified_name, jsignature) (* tag = 17 *) -> - write_byte ctx.cpool 17; - write_ui16 ctx.cpool bootstrap_method; - write_ui16 ctx.cpool (const ctx (ConstNameAndType(unqualified_name, jsignature))) - | ConstInvokeDynamic (bootstrap_method, unqualified_name, jsignature) (* tag = 18 *) -> - write_byte ctx.cpool 18; - write_ui16 ctx.cpool bootstrap_method; - write_ui16 ctx.cpool (const ctx (ConstNameAndType(unqualified_name, jsignature))) - | ConstModule unqualified_name (* tag = 19 *) -> - write_byte ctx.cpool 19; - write_ui16 ctx.cpool (const ctx (ConstUtf8 (unqualified_name))); - | ConstPackage unqualified_name (* tag = 20 *) -> - write_byte ctx.cpool 20; - write_ui16 ctx.cpool (const ctx (ConstUtf8 (unqualified_name))); - | ConstUnusable -> assert false); - ctx.ccount <- ret + 1; - ret - -let write_const ctx ch cconst = - write_ui16 ch (const ctx cconst) -;; - -let write_formal_type_params ctx ch tparams = - write_byte ch (Char.code '<'); - List.iter (fun (name,ext,impl) -> - write_string ch name; - (match ext with - | None -> () - | Some jsig -> - write_byte ch (Char.code ':'); - write_string ch (encode_sig ctx jsig)); - List.iter (fun jsig -> - write_byte ch (Char.code ':'); - write_string ch (encode_sig ctx jsig) - ) impl - ) tparams; - write_byte ch (Char.code '>'); -;; - -let write_complete_method_signature ctx ch (tparams : jtypes) msig throws = - if tparams <> [] then write_formal_type_params ctx ch tparams; - write_string ch (encode_sig ctx (TMethod(msig))); - if throws <> [] then List.iter (fun jsig -> - write_byte ch (Char.code '^'); - write_string ch (encode_sig ctx jsig) - ) throws -;; - -let write_access_flags ctx ch all_flags flags = - let value = List.fold_left (fun acc flag -> - try - acc lor (Hashtbl.find all_flags flag) - with Not_found -> - error ("Not found flag: " ^ (string_of_int (Obj.magic flag))) - ) 0 flags in - write_ui16 ch value -;; - -let rec write_ann_element ctx ch (name,eval) = - write_const ctx ch (ConstUtf8 name); - write_element_value ctx ch eval - -and write_annotation ctx ch ann = - write_const ctx ch (ConstUtf8 (encode_sig ctx ann.ann_type)); - write_ui16 ch (List.length ann.ann_elements); - List.iter (write_ann_element ctx ch) ann.ann_elements - -and write_element_value ctx ch value = match value with - | ValConst(jsig, cconst) -> (match jsig with - | TObject((["java";"lang"],"String"), []) -> - write_byte ch (Char.code 's') - | TByte | TChar | TDouble | TFloat | TInt | TLong | TShort | TBool -> - write_string ch (encode_sig ctx jsig) - | _ -> - let s = encode_sig ctx jsig in - error ("Invalid signature " ^ s ^ " for constant value")); - write_ui16 ch (const ctx cconst) - | ValEnum(jsig,name) -> - write_byte ch (Char.code 'e'); - write_const ctx ch (ConstUtf8 (encode_sig ctx jsig)); - write_const ctx ch (ConstUtf8 name) - | ValClass(jsig) -> - write_byte ch (Char.code 'c'); - let esig = match jsig with - | TObject(([],"Void"),[]) - | TObject((["java";"lang"],"Void"),[]) -> - "V" - | _ -> - encode_sig ctx jsig - in - write_const ctx ch (ConstUtf8 (esig)) - | ValAnnotation ann -> - write_byte ch (Char.code '@'); - write_annotation ctx ch ann - | ValArray(lvals) -> - write_byte ch (Char.code '['); - write_ui16 ch (List.length lvals); - List.iter (write_element_value ctx ch) lvals -;; - diff --git a/src-json/define.json b/src-json/define.json index dfc8de2f6ca..15c1d8db2e8 100644 --- a/src-json/define.json +++ b/src-json/define.json @@ -38,24 +38,11 @@ "define": "core-api", "doc": "Defined in the core API context." }, - { - "name": "CoreApiSerialize", - "define": "core-api-serialize", - "doc": "Mark some generated core API classes with the `Serializable` attribute on C#.", - "platforms": ["cs"] - }, { "name": "Cppia", "define": "cppia", "doc": "Generate cpp instruction assembly." }, - { - "name": "CsVer", - "define": "cs-ver", - "doc": "The C# version to target.", - "platforms": ["cs"], - "params": ["version"] - }, { "name": "NoCppiaAst", "define": "nocppiaast", @@ -102,12 +89,6 @@ "doc": "GenCPP experimental linking.", "platforms": ["cpp"] }, - { - "name": "DllImport", - "define": "dll-import", - "doc": "Handle Haxe-generated .NET DLL imports.", - "platforms": ["cs"] - }, { "name": "DocGen", "define": "doc-gen", @@ -141,12 +122,6 @@ "doc": "Use slow path for interface closures to save space.", "platforms": ["cpp"] }, - { - "name": "EraseGenerics", - "define": "erase-generics", - "doc": "Erase generic classes on C#.", - "platforms": ["cs"] - }, { "name": "EvalCallStackDepth", "define": "eval-call-stack-depth", @@ -190,12 +165,6 @@ "define": "filter-times", "doc": "Record per-filter execution times upon --times." }, - { - "name": "FastCast", - "define": "fast-cast", - "doc": "Enables an experimental casts cleanup on C# and Java.", - "platforms": ["cs", "java"] - }, { "name": "Fdb", "define": "fdb", @@ -223,25 +192,12 @@ "platforms": ["flash"], "deprecated": "The flash target will be removed for Haxe 5" }, - { - "devcomment": "force-lib-check is only here as a debug facility - compiler checking allows errors to be found more easily", - "name": "ForceLibCheck", - "define": "force-lib-check", - "doc": "Force the compiler to check `--net-lib` and `--java-lib` added classes (internal).", - "platforms": ["cs", "java"] - }, { "name": "ForceNativeProperty", "define": "force-native-property", "doc": "Tag all properties with `:nativeProperty` metadata for 3.1 compatibility.", "platforms": ["cpp"] }, - { - "name": "GencommonDebug", - "define": "gencommon-debug", - "doc": "GenCommon internal.", - "platforms": ["cs", "java"] - }, { "name": "Haxe3Compat", "define": "haxe3compat", @@ -444,20 +400,6 @@ "define": "interp", "doc": "The code is compiled to be run with `--interp`." }, - { - "name": "JarLegacyLoader", - "define": "jar-legacy-loader", - "doc": "Use the legacy loader to load .jar files on the JVM target.", - "platforms": ["java"], - "deprecated": "The legacy JAR loader will be removed in Haxe 5" - }, - { - "name": "JavaVer", - "define": "java-ver", - "doc": "Sets the Java version to be targeted.", - "platforms": ["java"], - "params": ["version: 5-7"] - }, { "name": "JsClassic", "define": "js-classic", @@ -502,29 +444,17 @@ "doc": "Generate source map for compiled files.", "platforms": ["php", "js"] }, - { - "name": "Jvm", - "define": "jvm", - "doc": "Generate jvm directly.", - "platforms": ["java"] - }, { "name": "JvmCompressionLevel", "define": "jvm.compression-level", "doc": "Set the compression level of the generated file between 0 (no compression) and 9 (highest compression). Default: 6", - "platforms": ["java"] + "platforms": ["jvm"] }, { "name": "JvmDynamicLevel", "define": "jvm.dynamic-level", "doc": "Controls the amount of dynamic support code being generated. 0 = none, 1 = field read/write optimization (default), 2 = compile-time method closures", - "platforms": ["java"] - }, - { - "name": "KeepOldOutput", - "define": "keep-old-output", - "doc": "Keep old source files in the output directory.", - "platforms": ["cs", "java"] + "platforms": ["jvm"] }, { "name": "LoopUnrollMaxCost", @@ -563,27 +493,6 @@ "define": "macro-times", "doc": "Display per-macro timing when used with `--times`." }, - { - "name": "NetVer", - "define": "net-ver", - "doc": "Sets the .NET version to be targeted.", - "platforms": ["cs"], - "params": ["version: 20-50"] - }, - { - "name": "NetcoreVer", - "define": "netcore-ver", - "doc": "Sets the .NET core version to be targeted", - "platforms": ["cs"], - "params": ["version: x.x.x"] - }, - { - "name": "NetTarget", - "define": "net-target", - "doc": "Sets the .NET target. `netcore` (.NET core), `xbox`, `micro` (Micro Framework), `compact` (Compact Framework) are some valid values. (default: `net`)", - "platforms": ["cs"], - "params": ["name"] - }, { "name": "NekoSource", "define": "neko-source", @@ -615,7 +524,7 @@ "name": "NoCompilation", "define": "no-compilation", "doc": "Disable final compilation.", - "platforms": ["cs", "java", "cpp", "hl"] + "platforms": ["cpp", "hl"] }, { "name": "NoDebug", @@ -651,12 +560,6 @@ "doc": "Don't substitute positions of inlined expressions with the position of the place of inlining.", "links": ["https://haxe.org/manual/class-field-inline.html"] }, - { - "name": "NoRoot", - "define": "no-root", - "doc": "Generate top-level types into the `haxe.root` namespace.", - "platforms": ["cs"] - }, { "name": "NoMacroCache", "define": "no-macro-cache", @@ -716,14 +619,8 @@ { "name": "RealPosition", "define": "real-position", - "doc": "Disables Haxe source mapping when targetting C#, removes position comments in Java and Php output.", - "platforms": ["cs", "java", "php"] - }, - { - "name": "ReplaceFiles", - "define": "replace-files", - "doc": "GenCommon internal.", - "platforms": ["cs", "java"] + "doc": "Removes position comments in Php output.", + "platforms": ["php"] }, { "name": "RetainUntypedMeta", @@ -763,7 +660,7 @@ "name": "StdEncodingUtf8", "define": "std-encoding-utf8", "doc": "Force utf8 encoding for stdin, stdout and stderr", - "platforms": ["java", "cs", "python"] + "platforms": ["python"] }, { "name": "Swc", @@ -853,12 +750,6 @@ "doc": "Defined for all system platforms.", "reserved": true }, - { - "name": "Unsafe", - "define": "unsafe", - "doc": "Allow unsafe code when targeting C#.", - "platforms": ["cs"] - }, { "name": "UseNekoc", "define": "use-nekoc", diff --git a/src-json/meta.json b/src-json/meta.json index 8d5d7b9e1f6..ebbd0a5c445 100644 --- a/src-json/meta.json +++ b/src-json/meta.json @@ -5,12 +5,6 @@ "doc": "Function ABI/calling convention.", "platforms": ["cpp"] }, - { - "name": "Abstract", - "metadata": ":abstract", - "doc": "Sets the underlying class implementation as `abstract`.", - "platforms": ["java", "cs"] - }, { "name": "Access", "metadata": ":access", @@ -43,7 +37,7 @@ "metadata": ":annotation", "doc": "Marks a class as a Java annotation", "params": ["Retention policy"], - "platforms": ["java"], + "platforms": ["jvm"], "targets": ["TClass"] }, { @@ -53,20 +47,6 @@ "targets": ["TAbstract", "TAbstractField"], "links": ["https://haxe.org/manual/types-abstract-array-access.html"] }, - { - "name": "AssemblyMeta", - "metadata": ":cs.assemblyMeta", - "doc": "Used to declare a native C# assembly attribute", - "platforms": ["cs"], - "targets": ["TClass"] - }, - { - "name": "AssemblyStrict", - "metadata": ":cs.assemblyStrict", - "doc": "Used to declare a native C# assembly attribute; is type checked", - "platforms": ["cs"], - "targets": ["TClass"] - }, { "name": "Ast", "metadata": ":ast", @@ -103,13 +83,6 @@ "targets": ["TClass"], "links": ["https://haxe.org/manual/target-flash-resources.html"] }, - { - "name": "BridgeProperties", - "metadata": ":bridgeProperties", - "doc": "Creates native property bridges for all Haxe properties in this class.", - "platforms": ["cs"], - "targets": ["TClass"] - }, { "name": "Build", "metadata": ":build", @@ -137,21 +110,6 @@ "doc": "Abstract forwards call to its underlying type.", "targets": ["TAbstract"] }, - { - "name": "Class", - "metadata": ":class", - "doc": "Used internally to annotate an enum that will be generated as a class.", - "platforms": ["java", "cs"], - "targets": ["TEnum"], - "internal": true - }, - { - "name": "ClassCode", - "metadata": ":classCode", - "doc": "Used to inject platform-native code into a class.", - "platforms": ["java", "cs"], - "targets": ["TClass"] - }, { "name": "Commutative", "metadata": ":commutative", @@ -202,21 +160,6 @@ "doc": "", "platforms": ["cpp"] }, - { - "name": "CsNative", - "metadata": ":csNative", - "doc": "Automatically added by `--net-lib` on classes generated from .NET DLL files.", - "platforms": ["cs"], - "targets": ["TClass", "TEnum"], - "internal": true - }, - { - "name": "CsUsing", - "metadata": ":cs.using", - "doc": "Add using directives to your module", - "platforms": ["cs"], - "targets": ["TClass"] - }, { "name": "Dce", "metadata": ":dce", @@ -244,13 +187,6 @@ "platforms": ["flash"], "internal": true }, - { - "name": "Delegate", - "metadata": ":delegate", - "doc": "Automatically added by `--net-lib` on delegates.", - "platforms": ["cs"], - "targets": ["TAbstract"] - }, { "name": "Depend", "metadata": ":depend", @@ -274,14 +210,6 @@ "doc": "Internally used to mark override fields for completion", "internal": true }, - { - "name": "DynamicObject", - "metadata": ":dynamicObject", - "doc": "Used internally to identify the Dynamic Object implementation.", - "platforms": ["java", "cs"], - "targets": ["TClass"], - "internal": true - }, { "name": "Eager", "metadata": ":eager", @@ -295,13 +223,6 @@ "targets": ["TAbstract"], "links": ["https://haxe.org/manual/types-abstract-enum.html"] }, - { - "name": "Event", - "metadata": ":event", - "doc": "Automatically added by `--net-lib` on events. Has no effect on types compiled by Haxe.", - "platforms": ["cs"], - "targets": ["TClassField"] - }, { "name": "Exhaustive", "metadata": ":exhaustive", @@ -419,7 +340,7 @@ "name": "FunctionCode", "metadata": ":functionCode", "doc": "Used to inject platform-native code into a function.", - "platforms": ["cpp", "java", "cs"] + "platforms": ["cpp"] }, { "name": "FunctionTailCode", @@ -472,14 +393,6 @@ "doc": "Used by the typer to mark fields that have untyped expressions.", "internal": true }, - { - "name": "HaxeGeneric", - "metadata": ":haxeGeneric", - "doc": "Used internally to annotate non-native generic classes.", - "platforms": ["cs"], - "targets": ["TClass", "TEnum"], - "internal": true - }, { "name": "HeaderClassCode", "metadata": ":headerClassCode", @@ -527,7 +440,6 @@ "name": "HxGen", "metadata": ":hxGen", "doc": "Annotates that an extern class was generated by Haxe.", - "platforms": ["java", "cs"], "targets": ["TClass", "TEnum"] }, { @@ -596,13 +508,6 @@ "doc": "Internally used by inline constructors filter to mark potentially inlineable objects.", "internal": true }, - { - "name": "Internal", - "metadata": ":internal", - "doc": "Generates the annotated field/class with 'internal' access.", - "platforms": ["java", "cs"], - "targets": ["TClass", "TEnum", "TClassField"] - }, { "name": "IsVar", "metadata": ":isVar", @@ -610,35 +515,18 @@ "targets": ["TClassField"], "links": ["https://haxe.org/manual/class-field-property-rules.html"] }, - { - "name": "JavaCanonical", - "metadata": ":javaCanonical", - "doc": "Used by the Java target to annotate the canonical path of the type.", - "platforms": ["java"], - "params": ["Output type package", "Output type name"], - "targets": ["TClass", "TEnum"] - }, { "name": "JavaDefault", "metadata": ":java.default", "doc": "Equivalent to the default modifier of the Java language", - "platforms": ["java"], - "params": [], + "platforms": ["jvm"], "targets": ["TClassField"] }, - { - "name": "JavaNative", - "metadata": ":javaNative", - "doc": "Automatically added by `--java-lib` on classes generated from JAR/class files.", - "platforms": ["java"], - "targets": ["TClass", "TEnum"], - "internal": true - }, { "name": "JvmSynthetic", "metadata": ":jvm.synthetic", "doc": "Mark generated class, field or method as synthetic", - "platforms": ["java"], + "platforms": ["jvm"], "targets": ["TClass", "TEnum", "TAnyField"] }, { @@ -686,7 +574,7 @@ "name": "LibType", "metadata": ":libType", "doc": "Used by `--net-lib` and `--java-lib` to mark a class that should not be checked (overrides, interfaces, etc) by the type loader.", - "platforms": ["java", "cs"], + "platforms": ["jvm"], "targets": ["TClass"], "internal": true }, @@ -746,31 +634,16 @@ "name": "NativeJni", "metadata": ":java.native", "doc": "Annotates that a function has implementation in native code through JNI.", - "platforms": ["java"], + "platforms": ["jvm"], "targets": ["TClassField"] }, - { - "name": "NativeChildren", - "metadata": ":nativeChildren", - "doc": "Annotates that all children from a type should be treated as if it were an extern definition - platform native.", - "platforms": ["java", "cs"], - "targets": ["TClass"] - }, { "name": "NativeGen", "metadata": ":nativeGen", "doc": "Annotates that a type should be treated as if it were an extern definition - platform native.", - "platforms": ["java", "cs", "python"], + "platforms": ["python"], "targets": ["TClass", "TEnum"] }, - { - "name": "NativeGeneric", - "metadata": ":nativeGeneric", - "doc": "Used internally to annotate native generic classes.", - "platforms": ["cs"], - "targets": ["TClass", "TEnum"], - "internal": true - }, { "name": "NativeProperty", "metadata": ":nativeProperty", @@ -976,7 +849,7 @@ "name": "Private", "metadata": ":private", "doc": "Marks a class field as being private.", - "platforms": ["cs"], + "platforms": ["jvm"], "targets": ["TClassField"] }, { @@ -989,14 +862,7 @@ "name": "Protected", "metadata": ":protected", "doc": "Marks a class field as being protected.", - "platforms": ["cs", "java", "flash"], - "targets": ["TClassField"] - }, - { - "name": "Property", - "metadata": ":property", - "doc": "Marks a field to be compiled as a native C# property.", - "platforms": ["cs"], + "platforms": ["jvm", "flash"], "targets": ["TClassField"] }, { @@ -1005,13 +871,6 @@ "doc": "Marks a class field, class or expression as pure (side-effect free).", "targets": ["TClass", "TClassField", "TExpr"] }, - { - "name": "ReadOnly", - "metadata": ":readOnly", - "doc": "Generates a field with the `readonly` native keyword.", - "platforms": ["cs"], - "targets": ["TClassField"] - }, { "name": "RealPath", "metadata": ":realPath", @@ -1087,21 +946,6 @@ "params": ["Class field name"], "targets": ["TClassField"] }, - { - "name": "SkipCtor", - "metadata": ":skipCtor", - "doc": "Used internally to generate a constructor as if it were a native type (no `__hx_ctor`).", - "platforms": ["java", "cs"], - "internal": true - }, - { - "name": "SkipReflection", - "metadata": ":skipReflection", - "doc": "Used internally to annotate a field that shouldn't have its reflection data generated.", - "platforms": ["java", "cs"], - "targets": ["TClassField"], - "internal": true - }, { "name": "Sound", "metadata": ":sound", @@ -1138,14 +982,14 @@ { "name": "Strict", "metadata": ":strict", - "doc": "Used to declare a native C# attribute or a native Java metadata; is type checked.", - "platforms": ["java", "cs"] + "doc": "Used to declare a native Java metadata; is type checked.", + "platforms": ["jvm"] }, { "name": "Struct", "metadata": ":struct", "doc": "Marks a class definition as a struct.", - "platforms": ["cs", "hl"], + "platforms": ["hl"], "targets": ["TClass"] }, { @@ -1161,13 +1005,6 @@ "doc": "Allows one to initialize the class with a structure that matches constructor parameters.", "targets": ["TClass"] }, - { - "name": "SuppressWarnings", - "metadata": ":suppressWarnings", - "doc": "Adds a `SuppressWarnings` annotation for the generated Java class.", - "platforms": ["java"], - "targets": ["TClass"] - }, { "name": "TailRecursion", "metadata": ":tailRecursion", @@ -1181,14 +1018,6 @@ "platforms": ["cpp"], "targets": ["TClassField"] }, - { - "name": "Throws", - "metadata": ":throws", - "doc": "Adds a `throws` declaration to the generated function.", - "platforms": ["java"], - "params": ["Type as String"], - "targets": ["TClassField"] - }, { "name": "This", "metadata": ":this", @@ -1209,13 +1038,6 @@ "doc": "Internally used.", "internal": true }, - { - "name": "Transient", - "metadata": ":transient", - "doc": "Adds the `transient` flag to the class field.", - "platforms": ["java"], - "targets": ["TClassField"] - }, { "name": "Transitive", "metadata": ":transitive", @@ -1232,7 +1054,7 @@ "name": "Volatile", "metadata": ":volatile", "doc": "", - "platforms": ["java", "cs"] + "platforms": ["jvm"] }, { "name": "UnifyMinDynamic", @@ -1246,13 +1068,6 @@ "doc": "", "platforms": ["cpp"] }, - { - "name": "Unsafe", - "metadata": ":unsafe", - "doc": "Declares a class, or a method with the C#'s `unsafe` flag.", - "platforms": ["cs"], - "targets": ["TClass", "TClassField"] - }, { "name": "Used", "metadata": ":used", diff --git a/src-prebuild/prebuild.ml b/src-prebuild/prebuild.ml index 8fd05007672..22e54e6cc65 100644 --- a/src-prebuild/prebuild.ml +++ b/src-prebuild/prebuild.ml @@ -44,8 +44,7 @@ let as_platforms = function | JString "flash" -> "Flash" | JString "php" -> "Php" | JString "cpp" -> "Cpp" - | JString "cs" -> "Cs" - | JString "java" -> "Java" + | JString "jvm" -> "Jvm" | JString "python" -> "Python" | JString "hl" -> "Hl" | JString "eval" -> "Eval" diff --git a/src/codegen/dotnet.ml b/src/codegen/dotnet.ml deleted file mode 100644 index 0259e24b41b..00000000000 --- a/src/codegen/dotnet.ml +++ /dev/null @@ -1,1322 +0,0 @@ -(* - The Haxe Compiler - Copyright (C) 2005-2019 Haxe Foundation - - This program is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License - as published by the Free Software Foundation; either version 2 - of the License, or (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. -*) -open ExtString -open Common -open Globals -open Ast -open IlData -open IlMeta -open NativeLibraries - -(* see http://msdn.microsoft.com/en-us/library/2sk3x8a7(v=vs.71).aspx *) -let cs_binops = - [Ast.OpAdd, "op_Addition"; - Ast.OpSub, "op_Subtraction"; - Ast.OpMult, "op_Multiply"; - Ast.OpDiv, "op_Division"; - Ast.OpMod, "op_Modulus"; - Ast.OpXor, "op_ExclusiveOr"; - Ast.OpOr, "op_BitwiseOr"; - Ast.OpAnd, "op_BitwiseAnd"; - Ast.OpBoolAnd, "op_LogicalAnd"; - Ast.OpBoolOr, "op_LogicalOr"; - Ast.OpAssign, "op_Assign"; - Ast.OpShl, "op_LeftShift"; - Ast.OpShr, "op_RightShift"; - Ast.OpShr, "op_SignedRightShift"; - Ast.OpUShr, "op_UnsignedRightShift"; - Ast.OpEq, "op_Equality"; - Ast.OpGt, "op_GreaterThan"; - Ast.OpLt, "op_LessThan"; - Ast.OpNotEq, "op_Inequality"; - Ast.OpGte, "op_GreaterThanOrEqual"; - Ast.OpLte, "op_LessThanOrEqual"; - Ast.OpAssignOp Ast.OpMult, "op_MultiplicationAssignment"; - Ast.OpAssignOp Ast.OpSub, "op_SubtractionAssignment"; - Ast.OpAssignOp Ast.OpXor, "op_ExclusiveOrAssignment"; - Ast.OpAssignOp Ast.OpShl, "op_LeftShiftAssignment"; - Ast.OpAssignOp Ast.OpMod, "op_ModulusAssignment"; - Ast.OpAssignOp Ast.OpAdd, "op_AdditionAssignment"; - Ast.OpAssignOp Ast.OpAnd, "op_BitwiseAndAssignment"; - Ast.OpAssignOp Ast.OpOr, "op_BitwiseOrAssignment"; - (* op_Comma *) - Ast.OpAssignOp Ast.OpDiv, "op_DivisionAssignment";] - -let cs_unops = - [Ast.Decrement, "op_Decrement"; - Ast.Increment, "op_Increment"; - Ast.Neg, "op_UnaryNegation"; - Ast.Not, "op_LogicalNot"; - Ast.NegBits, "op_OnesComplement"] - -let netname_to_hx name = - let len = String.length name in - let chr = String.get name 0 in - String.make 1 (Char.uppercase_ascii chr) ^ (String.sub name 1 (len-1)) - -(* -net-lib implementation *) - -type net_lib_ctx = { - nstd : bool; - ncom : Common.context; - nil : IlData.ilctx; -} - -let is_haxe_keyword = function - | "cast" | "extern" | "function" | "in" | "typedef" | "using" | "var" | "untyped" | "inline" -> true - | _ -> false - -let hxpath_to_net ctx path = - try - Hashtbl.find ctx.ncom.net_path_map path - with - | Not_found -> - [],[],"Not_found" - -let add_cs = function - | "haxe" :: ns -> "haxe" :: ns - | "std" :: ns -> "std" :: ns - | "cs" :: ns -> "cs" :: ns - | "system" :: ns -> "cs" :: "system" :: ns - | ns -> ns - -let escape_chars = - String.replace_chars (fun chr -> - if (chr >= 'a' && chr <= 'z') || (chr >= 'A' && chr <= 'Z') || (chr >= '0' && chr <= '9') || chr = '_' then - Char.escaped chr - else - "_x" ^ (string_of_int (Char.code chr)) ^ "_") - -let netcl_to_hx cl = - let cl = if String.length cl > 0 && String.get cl 0 >= 'a' && String.get cl 0 <= 'z' then - Char.escaped (Char.uppercase_ascii (String.get cl 0)) ^ (String.sub cl 1 (String.length cl - 1)) - else - cl - in - try - let cl, nargs = String.split cl "`" in - (escape_chars cl) ^ "_" ^ nargs - with | Invalid_string -> - escape_chars cl - -let netpath_to_hx std = function - | [],[], cl -> [], netcl_to_hx cl - | ns,[], cl -> - let ns = (List.map (fun s -> String.lowercase (escape_chars s)) ns) in - add_cs ns, netcl_to_hx cl - | ns,(nhd :: ntl as nested), cl -> - let nested = List.map (netcl_to_hx) nested in - let ns = (List.map (fun s -> String.lowercase (escape_chars s)) ns) @ [nhd] in - add_cs ns, String.concat "_" nested ^ "_" ^ netcl_to_hx cl - -let lookup_ilclass std com ilpath = - let path = netpath_to_hx std ilpath in - List.fold_right (fun net_lib acc -> - match acc with - | None -> net_lib#lookup path - | Some p -> acc - ) com.native_libs.net_libs None - -let discard_nested = function - | (ns,_),cl -> (ns,[]),cl - -let mk_type_path ctx path params = - let pack, sub, name = match path with - | ns,[], cl -> - ns, None, netcl_to_hx cl - | ns, (nhd :: ntl as nested), cl -> - let nhd = netcl_to_hx nhd in - let nested = List.map (netcl_to_hx) nested in - ns, Some (String.concat "_" nested ^ "_" ^ netcl_to_hx cl), nhd - in - make_ptp_ct_null { - tpackage = fst (netpath_to_hx ctx.nstd (pack,[],"")); - Ast.tname = name; - tparams = params; - tsub = sub; - } - -let raw_type_path ctx path params = - let tp = { - tpackage = fst path; - Ast.tname = snd path; - tparams = params; - tsub = None; - } in - make_ptp tp null_pos - -let rec convert_signature ctx p = function - | LVoid -> - mk_type_path ctx ([],[],"Void") [] - | LBool -> - mk_type_path ctx ([],[],"Bool") [] - | LChar -> - mk_type_path ctx (["cs";"types"],[],"Char16") [] - | LInt8 -> - mk_type_path ctx (["cs";"types"],[],"Int8") [] - | LUInt8 -> - mk_type_path ctx (["cs";"types"],[],"UInt8") [] - | LInt16 -> - mk_type_path ctx (["cs";"types"],[],"Int16") [] - | LUInt16 -> - mk_type_path ctx (["cs";"types"],[],"UInt16") [] - | LInt32 -> - mk_type_path ctx ([],[],"Int") [] - | LUInt32 -> - mk_type_path ctx ([],[],"UInt") [] - | LInt64 -> - mk_type_path ctx (["haxe"],[],"Int64") [] - | LUInt64 -> - mk_type_path ctx (["cs";"types"],[],"UInt64") [] - | LFloat32 -> - mk_type_path ctx ([],[],"Single") [] - | LFloat64 -> - mk_type_path ctx ([],[],"Float") [] - | LString -> - mk_type_path ctx (["std"],[],"String") [] - | LObject -> - mk_type_path ctx ([],[],"Dynamic") [] - | LPointer s | LManagedPointer s -> - mk_type_path ctx (["cs"],[],"Pointer") [ TPType (convert_signature ctx p s,null_pos) ] - | LTypedReference -> - mk_type_path ctx (["cs";"system"],[],"TypedReference") [] - | LIntPtr -> - mk_type_path ctx (["cs";"system"],[],"IntPtr") [] - | LUIntPtr -> - mk_type_path ctx (["cs";"system"],[],"UIntPtr") [] - | LValueType (s,args) | LClass (s,args) -> - mk_type_path ctx s (List.map (fun s -> TPType (convert_signature ctx p s,null_pos)) args) - | LTypeParam i -> - mk_type_path ctx ([],[],"T" ^ string_of_int i) [] - | LMethodTypeParam i -> - mk_type_path ctx ([],[],"M" ^ string_of_int i) [] - | LVector s -> - mk_type_path ctx (["cs"],[],"NativeArray") [TPType (convert_signature ctx p s,null_pos)] - (* | LArray of ilsig_norm * (int option * int option) array *) - | LMethod (_,ret,args) -> - CTFunction (List.map (fun v -> convert_signature ctx p v,null_pos) args, (convert_signature ctx p ret,null_pos)) - | _ -> mk_type_path ctx ([],[], "Dynamic") [] - -let ilpath_s = function - | ns,[], name -> s_type_path (ns,name) - | [],nested,name -> String.concat "." nested ^ "." ^ name - | ns, nested, name -> String.concat "." ns ^ "." ^ String.concat "." nested ^ "." ^ name - -let get_cls = function - | _,_,c -> c - -let has_attr expected_name expected_ns ilcls = - let check_flag name ns = (name = expected_name && ns = expected_ns) in - List.exists (fun a -> - match a.ca_type with - | TypeRef r -> - check_flag r.tr_name r.tr_namespace - | TypeDef d -> - check_flag d.td_name d.td_namespace - | Method m -> - (match m.m_declaring with - | Some d -> - check_flag d.td_name d.td_namespace - | _ -> false) - | MemberRef r -> - (match r.memr_class with - | TypeRef r -> - check_flag r.tr_name r.tr_namespace - | TypeDef d -> - check_flag d.td_name d.td_namespace - | _ -> false) - | _ -> - false - ) ilcls.cattrs - -(* TODO: When possible on Haxe, use this to detect flag enums, and make an abstract with @:op() *) -(* that behaves like an enum, and with an enum as its underlying type *) -let enum_is_flag = has_attr "FlagsAttribute" ["System"] - -let is_compiler_generated = has_attr "CompilerGeneratedAttribute" ["System"; "Runtime"; "CompilerServices"] - -let convert_ilenum ctx p ?(is_flag=false) ilcls = - let meta = ref [ - Meta.Native, [EConst (String (ilpath_s ilcls.cpath,SDoubleQuotes) ), p], p; - Meta.CsNative, [], p; - ] in - - let data = ref [] in - List.iter (fun f -> match f.fname with - | "value__" -> () - | _ when not (List.mem CStatic f.fflags.ff_contract) -> () - | _ -> - let meta, const = match f.fconstant with - | Some IChar i - | Some IByte i - | Some IShort i -> - [Meta.CsNative, [EConst (Int (string_of_int i, None) ), p], p ], Int64.of_int i - | Some IInt i -> - [Meta.CsNative, [EConst (Int (Int32.to_string i, None) ), p], p ], Int64.of_int32 i - | Some IFloat32 f | Some IFloat64 f -> - [], Int64.of_float f - | Some IInt64 i -> - [], i - | _ -> - [], Int64.zero - in - data := ( { ec_name = f.fname,null_pos; ec_doc = None; ec_meta = meta; ec_args = []; ec_pos = p; ec_params = []; ec_type = None; }, const) :: !data; - ) ilcls.cfields; - let data = List.stable_sort (fun (_,i1) (_,i2) -> Int64.compare i1 i2) (List.rev !data) in - - let _, c = netpath_to_hx ctx.nstd ilcls.cpath in - let name = netname_to_hx c in - EEnum { - d_name = (if is_flag then name ^ "_FlagsEnum" else name),null_pos; - d_doc = None; - d_params = []; (* enums never have type parameters *) - d_meta = !meta; - d_flags = [EExtern]; - d_data = List.map fst data; - } - -let rec has_unmanaged = function - | LPointer _ -> true - | LManagedPointer s -> has_unmanaged s - | LValueType (p,pl) -> List.exists (has_unmanaged) pl - | LClass (p,pl) -> List.exists (has_unmanaged) pl - | LVector s -> has_unmanaged s - | LArray (s,a) -> has_unmanaged s - | LMethod (c,r,args) -> has_unmanaged r || List.exists (has_unmanaged) args - | _ -> false - -let convert_ilfield ctx p field = - if not (Common.defined ctx.ncom Define.Unsafe) && has_unmanaged field.fsig.snorm then raise Exit; - let p = { p with pfile = p.pfile ^" (" ^field.fname ^")" } in - let cff_doc = None in - let cff_pos = p in - let cff_meta = ref [] in - let cff_name = match field.fname with - | name when String.length name > 5 -> - (match String.sub name 0 5 with - | "__hx_" -> raise Exit - | _ -> name) - | name -> name - in - let cff_access = match field.fflags.ff_access with - | FAFamily | FAFamOrAssem -> (APrivate,null_pos) - | FAPublic -> (APublic,null_pos) - | _ -> raise Exit (* private instances aren't useful on externs *) - in - let readonly, acc = List.fold_left (fun (readonly,acc) -> function - | CStatic -> readonly, (AStatic,null_pos) :: acc - | CInitOnly | CLiteral -> true, acc - | _ -> readonly,acc - ) (false,[cff_access]) field.fflags.ff_contract in - if Common.raw_defined ctx.ncom "net_loader_debug" then - Printf.printf "\t%sfield %s : %s\n" (if List.mem_assoc AStatic acc then "static " else "") cff_name (IlMetaDebug.ilsig_s field.fsig.ssig); - let kind = match readonly with - | true -> - cff_meta := (Meta.ReadOnly, [], cff_pos) :: !cff_meta; - FProp (("default",null_pos), ("never",null_pos), Some (convert_signature ctx p field.fsig.snorm,null_pos), None) - | false -> - FVar (Some (convert_signature ctx p field.fsig.snorm,null_pos), None) - in - let cff_name, cff_meta = - if String.get cff_name 0 = '%' then - let name = (String.sub cff_name 1 (String.length cff_name - 1)) in - "_" ^ name, - (Meta.Native, [EConst (String (name,SDoubleQuotes) ), cff_pos], cff_pos) :: !cff_meta - else - cff_name, !cff_meta - in - { - cff_name = cff_name,null_pos; - cff_doc = cff_doc; - cff_pos = cff_pos; - cff_meta = cff_meta; - cff_access = acc; - cff_kind = kind; - } - -let convert_ilevent ctx p ev = - let p = { p with pfile = p.pfile ^" (" ^ev.ename ^")" } in - let name = ev.ename in - let kind = FVar (Some (convert_signature ctx p ev.esig.snorm,null_pos), None) in - let meta = [Meta.Event, [], p; Meta.Keep,[],p; Meta.SkipReflection,[],p] in - let acc = [APrivate,null_pos] in - let add_m acc m = match m with - | None -> acc - | Some (name,flags) -> - if List.mem (CMStatic) flags.mf_contract then - (AStatic,null_pos) :: acc - else - acc - in - if Common.raw_defined ctx.ncom "net_loader_debug" then - Printf.printf "\tevent %s : %s\n" name (IlMetaDebug.ilsig_s ev.esig.ssig); - let acc = add_m acc ev.eadd in - let acc = add_m acc ev.eremove in - let acc = add_m acc ev.eraise in - { - cff_name = name,null_pos; - cff_doc = None; - cff_pos = p; - cff_meta = meta; - cff_access = acc; - cff_kind = kind; - } - -let convert_ilmethod ctx p is_interface m is_explicit_impl = - if not (Common.defined ctx.ncom Define.Unsafe) && has_unmanaged m.msig.snorm then raise Exit; - let force_check = Common.defined ctx.ncom Define.ForceLibCheck in - let p = { p with pfile = p.pfile ^" (" ^m.mname ^")" } in - let cff_doc = None in - let cff_pos = p in - let cff_name = match m.mname with - | ".ctor" -> "new" - | ".cctor"-> raise Exit (* __init__ field *) - | "Finalize" -> raise Exit (* destructor (~ClassName) *) - | "Equals" | "GetHashCode" -> raise Exit - | name when String.length name > 5 -> - (match String.sub name 0 5 with - | "__hx_" -> raise Exit - | _ -> name) - | name -> name - in - let meta = [] in - let acc, meta = match m.mflags.mf_access with - | FAFamily | FAFamOrAssem -> - (APrivate,null_pos), ((Meta.Protected, [], p) :: meta) - | FAPublic -> (APublic,null_pos), meta - | _ -> - if Common.raw_defined ctx.ncom "net_loader_debug" then - Printf.printf "\tmethod %s (skipped) : %s\n" cff_name (IlMetaDebug.ilsig_s m.msig.ssig); - raise Exit - in - let is_static = ref false in - let acc, is_final = List.fold_left (fun (acc,is_final) -> function - | CMStatic when cff_name <> "new" -> is_static := true; (AStatic,null_pos) :: acc, is_final - | CMVirtual when is_final = None -> acc, Some false - | CMFinal -> acc, Some true - | _ -> acc, is_final - ) ([acc],None) m.mflags.mf_contract in - let acc = (AOverload,p) :: acc in - if Common.raw_defined ctx.ncom "net_loader_debug" then - Printf.printf "\t%smethod %s : %s\n" (if !is_static then "static " else "") cff_name (IlMetaDebug.ilsig_s m.msig.ssig); - - let acc = match is_final with - | None | Some true when not force_check && not !is_static -> - (AFinal,null_pos) :: acc - | _ -> - acc - in - let meta = if is_explicit_impl then - (Meta.NoCompletion,[],p) :: (Meta.SkipReflection,[],p) :: meta - else - meta - in - (* let meta = if List.mem OSynchronized m.mflags.mf_interop then *) - (* (Meta.Synchronized,[],p) :: meta *) - (* else *) - (* meta *) - (* in *) - - let rec change_sig = function - | LManagedPointer s -> LManagedPointer (change_sig s) - | LPointer s -> LPointer (change_sig s) - | LValueType (p,pl) -> LValueType(p, List.map change_sig pl) - | LClass (p,pl) -> LClass(p, List.map change_sig pl) - | LTypeParam i -> LObject - | LVector s -> LVector (change_sig s) - | LArray (s,a) -> LArray (change_sig s, a) - | LMethod (c,r,args) -> LMethod (c, change_sig r, List.map change_sig args) - | p -> p - in - let change_sig = if !is_static then change_sig else (fun s -> s) in - - let ret = - if String.length cff_name > 4 && String.sub cff_name 0 4 = "set_" then - match m.mret.snorm, m.margs with - | LVoid, [_,_,s] -> - s.snorm - | _ -> m.mret.snorm - else - m.mret.snorm - in - - let kind = - let args = List.map (fun (name,flag,s) -> - let t = match s.snorm with - | LManagedPointer s -> - let is_out = List.mem POut flag.pf_io && not (List.mem PIn flag.pf_io) in - let name = if is_out then "Out" else "Ref" in - mk_type_path ctx (["cs"],[],name) [ TPType (convert_signature ctx p s,null_pos) ] - | _ -> - convert_signature ctx p (change_sig s.snorm) - in - (name,null_pos),false,[],Some (t,null_pos),None) m.margs - in - let ret = convert_signature ctx p (change_sig ret) in - let types = List.map (fun t -> - { - tp_name = "M" ^ string_of_int t.tnumber,null_pos; - tp_params = []; - tp_constraints = None; - tp_default = None; - tp_meta = []; - } - ) m.mtypes in - FFun { - f_params = types; - f_args = args; - f_type = Some (ret,null_pos); - f_expr = None; - } - in - let cff_name, cff_meta = - if String.get cff_name 0 = '%' then - let name = (String.sub cff_name 1 (String.length cff_name - 1)) in - "_" ^ name, - (Meta.Native, [EConst (String (name,SDoubleQuotes) ), cff_pos], cff_pos) :: meta - else - cff_name, meta - in - let acc = match m.moverride with - | None -> - if not is_interface && List.mem IAbstract m.mflags.mf_impl then (AAbstract,null_pos) :: acc else acc - | _ when cff_name = "new" -> acc - | Some (path,s) -> match lookup_ilclass ctx.nstd ctx.ncom path with - | Some ilcls when not (List.mem SInterface ilcls.cflags.tdf_semantics) -> - (AOverride,null_pos) :: acc - | None when ctx.ncom.verbose -> - print_endline ("(net-lib) A referenced assembly for path " ^ ilpath_s path ^ " was not found"); - acc - | _ -> acc - in - { - cff_name = cff_name,null_pos; - cff_doc = cff_doc; - cff_pos = cff_pos; - cff_meta = cff_meta; - cff_access = acc; - cff_kind = kind; - } - -let convert_ilprop ctx p prop is_explicit_impl = - if not (Common.defined ctx.ncom Define.Unsafe) && has_unmanaged prop.psig.snorm then raise Exit; - let p = { p with pfile = p.pfile ^" (" ^prop.pname ^")" } in - let pmflags = match prop.pget, prop.pset with - | Some(_,fl1), _ -> Some fl1 - | _, Some(_,fl2) -> Some fl2 - | _ -> None - in - let cff_access = match pmflags with - | Some { mf_access = FAFamily | FAFamOrAssem } -> (APrivate,null_pos) - | Some { mf_access = FAPublic } -> (APublic,null_pos) - | _ -> raise Exit (* non-public / protected fields don't interest us *) - in - let access acc = acc.mf_access in - let cff_access = match pmflags with - | Some m when List.mem CMStatic m.mf_contract -> - [AStatic,null_pos;cff_access] - | _ -> [cff_access] - in - let get = match prop.pget with - | None -> "never" - | Some(s,_) when String.length s <= 4 || String.sub s 0 4 <> "get_" -> - raise Exit (* special (?) getter; not used *) - | Some(_,m) when access m <> FAPublic -> (match access m with - | FAFamily - | FAFamOrAssem -> "null" - | _ -> "never") - | Some _ -> "get" - in - let set = match prop.pset with - | None -> "never" - | Some(s,_) when String.length s <= 4 || String.sub s 0 4 <> "set_" -> - raise Exit (* special (?) getter; not used *) - | Some(_,m) when access m <> FAPublic -> (match access m with - | FAFamily - | FAFamOrAssem -> "never" - | _ -> "never"); - | Some _ -> "set" - in - if Common.raw_defined ctx.ncom "net_loader_debug" then - Printf.printf "\tproperty %s (%s,%s) : %s\n" prop.pname get set (IlMetaDebug.ilsig_s prop.psig.ssig); - let ilsig = match prop.psig.snorm with - | LMethod (_,ret,[]) -> ret - | s -> raise Exit - in - - let meta = if is_explicit_impl then - [ Meta.NoCompletion,[],p; Meta.SkipReflection,[],p ] - else - [] - in - - let kind = - FProp ((get,null_pos), (set,null_pos), Some(convert_signature ctx p ilsig,null_pos), None) - in - { - cff_name = prop.pname,null_pos; - cff_doc = None; - cff_pos = p; - cff_meta = meta; - cff_access = cff_access; - cff_kind = kind; - } - -let get_type_path ctx ct = match ct with | CTPath ptp -> ptp | _ -> die "" __LOC__ - -let is_explicit ctx ilcls i = - let s = match i with - | LClass(path,_) | LValueType(path,_) -> ilpath_s path - | _ -> die "" __LOC__ - in - let len = String.length s in - List.exists (fun m -> - String.length m.mname > len && String.sub m.mname 0 len = s - ) ilcls.cmethods - -let mke e p = (e,p) - -let mk_special_call name p args = - mke (ECast( mke (EUntyped( mke (ECall( mke (EConst(Ident name)) p, args )) p )) p , None)) p - -let mk_this_call name p args = - mke (ECall( mke (efield(mke (EConst(Ident "this")) p ,name)) p, args )) p - -let mk_metas metas p = - List.map (fun m -> m,[],p) metas - -let mk_abstract_fun name p kind metas acc = - let metas = mk_metas metas p in - { - cff_name = name,null_pos; - cff_doc = None; - cff_pos = p; - cff_meta = metas; - cff_access = acc; - cff_kind = kind; - } - -let convert_fun_arg ctx p = function - | LManagedPointer s -> - mk_type_path ctx (["cs"],[],"Ref") [ TPType (convert_signature ctx p s,null_pos) ],p - | s -> - convert_signature ctx p s,p - -let convert_fun ctx p ret args = - let args = List.map (convert_fun_arg ctx p) args in - CTFunction(args, (convert_signature ctx p ret,null_pos)) - -let get_clsname ctx cpath = - match netpath_to_hx ctx.nstd cpath with - | (_,n) -> n - -let convert_delegate ctx p ilcls = - let p = { p with pfile = p.pfile ^" (abstract delegate)" } in - (* will have the following methods: *) - (* - new (haxeType:Func) *) - (* - FromHaxeFunction(haxeType) *) - (* - Invoke() *) - (* - AsDelegate():Super *) - (* - @:op(A+B) Add(d:absType) *) - (* - @:op(A-B) Remove(d:absType) *) - let abs_type = mk_type_path ctx (ilcls.cpath) (List.map (fun t -> TPType (mk_type_path ctx ([],[],"T" ^ string_of_int t.tnumber) [],null_pos)) ilcls.ctypes) in - let invoke = List.find (fun m -> m.mname = "Invoke") ilcls.cmethods in - let ret = invoke.mret.snorm in - let args = List.map (fun (_,_,s) -> s.snorm) invoke.margs in - let haxe_type = convert_fun ctx p ret args in - let types = List.map (fun t -> - { - tp_name = ("T" ^ string_of_int t.tnumber),null_pos; - tp_params = []; - tp_constraints = None; - tp_default = None; - tp_meta = []; - } - ) ilcls.ctypes in - let mk_op_fn op name p = - let fn_name = List.assoc op cs_binops in - let clsname = match ilcls.cpath with - | (ns,inner,n) -> get_clsname ctx (ns,inner,"Delegate_"^n) - in - let expr = (ECall( (efield( (EConst(Ident (clsname)),p), fn_name ),p), [(EConst(Ident"arg1"),p);(EConst(Ident"arg2"),p)]),p) in - FFun { - f_params = types; - f_args = [("arg1",null_pos),false,[],Some (abs_type,null_pos),None;("arg2",null_pos),false,[],Some (abs_type,null_pos),None]; - f_type = Some (abs_type,null_pos); - f_expr = Some ( (EReturn (Some expr), p) ); - } - in - let mk_op op name = - let p = { p with pfile = p.pfile ^" (op " ^ name ^ ")" } in - { - cff_name = name,null_pos; - cff_doc = None; - cff_pos = p; - cff_meta = [ Meta.Op, [ (EBinop(op, (EConst(Ident"A"),p), (EConst(Ident"B"),p)),p) ], p ]; - cff_access = [APublic,null_pos;AInline,null_pos;AStatic,null_pos;AExtern,null_pos]; - cff_kind = mk_op_fn op name p; - } - in - let params = (List.map (fun s -> - TPType (mk_type_path ctx ([],[],fst s.tp_name) [],null_pos) - ) types) in - let underlying_type = match ilcls.cpath with - | ns,inner,name -> - mk_type_path ctx (ns,inner,"Delegate_" ^ name) params - in - - let fn_new = FFun { - f_params = []; - f_args = [("hxfunc",null_pos),false,[],Some (haxe_type,null_pos),None]; - f_type = None; - f_expr = Some ( EBinop(Ast.OpAssign, (EConst(Ident "this"),p), (mk_special_call "__delegate__" p [EConst(Ident "hxfunc"),p]) ), p ); - } in - let fn_from_hx = FFun { - f_params = types; - f_args = [("hxfunc",null_pos),false,[],Some (haxe_type,null_pos),None]; - f_type = Some( mk_type_path ctx ilcls.cpath params,null_pos ); - f_expr = Some( EReturn( Some (mk_special_call "__delegate__" p [EConst(Ident "hxfunc"),p] )), p); - } in - let fn_asdel = FFun { - f_params = []; - f_args = []; - f_type = None; - f_expr = Some( - EReturn( Some ( EConst(Ident "this"), p ) ), p - ); - } in - let fn_new = mk_abstract_fun "new" p fn_new [] [APublic,null_pos;AInline,null_pos;AExtern,null_pos] in - let fn_from_hx = mk_abstract_fun "FromHaxeFunction" p fn_from_hx [Meta.From] [APublic,null_pos;AInline,null_pos;AStatic,null_pos;AExtern,null_pos] in - let fn_asdel = mk_abstract_fun "AsDelegate" p fn_asdel [] [APublic,null_pos;AInline,null_pos;AExtern,null_pos] in - let _, c = netpath_to_hx ctx.nstd ilcls.cpath in - EAbstract { - d_name = netname_to_hx c,null_pos; - d_doc = None; - d_params = types; - d_meta = mk_metas [Meta.Delegate; Meta.Forward] p; - d_flags = [AbOver (underlying_type,null_pos)]; - d_data = [fn_new;fn_from_hx;fn_asdel;mk_op Ast.OpAdd "Add";mk_op Ast.OpSub "Remove"]; - } - -let convert_ilclass ctx p ?(delegate=false) ilcls = match ilcls.csuper with - | Some { snorm = LClass ((["System"],[],"Enum"),[]) } -> - convert_ilenum ctx p ilcls - | _ -> - let flags = ref [HExtern] in - (* todo: instead of CsNative, use more specific definitions *) - if Common.raw_defined ctx.ncom "net_loader_debug" then begin - let sup = match ilcls.csuper with | None -> [] | Some c -> [IlMetaDebug.ilsig_s c.ssig] in - let sup = sup @ List.map (fun i -> IlMetaDebug.ilsig_s i.ssig) ilcls.cimplements in - print_endline ("converting " ^ ilpath_s ilcls.cpath ^ " : " ^ (String.concat ", " sup)) - end; - let meta = ref [Meta.CsNative, [], p; Meta.Native, [EConst (String (ilpath_s ilcls.cpath,SDoubleQuotes) ), p], p] in - let force_check = Common.defined ctx.ncom Define.ForceLibCheck in - if not force_check then - meta := (Meta.LibType,[],p) :: !meta; - - let is_interface = ref false in - let is_abstract = ref false in - let is_sealed = ref false in - List.iter (fun f -> match f with - | SSealed -> - flags := HFinal :: !flags; - is_sealed := true - | SInterface -> - is_interface := true; - flags := HInterface :: !flags - | SAbstract -> - meta := (Meta.Abstract, [], p) :: !meta; - is_abstract := true; - | _ -> () - ) ilcls.cflags.tdf_semantics; - - (* static class = abstract sealed class - in this case we don't want an abstract flag *) - if !is_abstract && not !is_interface && not !is_sealed then flags := HAbstract :: !flags; - - (* (match ilcls.cflags.tdf_vis with *) - (* | VPublic | VNestedFamOrAssem | VNestedFamily -> () *) - (* | _ -> raise Exit); *) - (match ilcls.csuper with - | Some { snorm = LClass ( (["System"],[],"Object"), [] ) } -> () - | Some ({ snorm = LClass ( (["System"],[],"ValueType"), [] ) } as s) -> - flags := HExtends (get_type_path ctx (convert_signature ctx p s.snorm)) :: !flags; - meta := (Meta.Struct,[],p) :: !meta - | Some { snorm = LClass ( (["haxe";"lang"],[],"HxObject"), [] ) } -> - meta := (Meta.HxGen,[],p) :: !meta - | Some s -> - flags := HExtends (get_type_path ctx (convert_signature ctx p s.snorm)) :: !flags - | _ -> ()); - - let has_explicit_ifaces = ref false in - List.iter (fun i -> - match i.snorm with - | LClass ( (["haxe";"lang"],[], "IHxObject"), _ ) -> - meta := (Meta.HxGen,[],p) :: !meta - (* | i when is_explicit ctx ilcls i -> () *) - | i -> - if is_explicit ctx ilcls i then has_explicit_ifaces := true; - flags := if !is_interface then - HExtends (get_type_path ctx (convert_signature ctx p i)) :: !flags - else - HImplements (get_type_path ctx (convert_signature ctx p i)) :: !flags - ) ilcls.cimplements; - (* this is needed because of explicit interfaces. see http://msdn.microsoft.com/en-us/library/aa288461(v=vs.71).aspx *) - (* explicit interfaces can't be mapped into Haxe in any way - since their fields can't be accessed directly, but they still implement that interface *) - if !has_explicit_ifaces && force_check then (* do not check on this specific case *) - meta := (Meta.LibType,[],p) :: !meta; - - (* ArrayAccess *) - ignore (List.exists (function - | { psig = { snorm = LMethod(_,ret,[v]) } } -> - flags := if !is_interface then - (HExtends( raw_type_path ctx ([],"ArrayAccess") [ TPType (convert_signature ctx p ret,null_pos) ]) :: !flags) - else - (HImplements( raw_type_path ctx ([],"ArrayAccess") [ TPType (convert_signature ctx p ret,null_pos) ]) :: !flags); - true - | _ -> false) ilcls.cprops); - - let fields = ref [] in - let run_fields fn f = - List.iter (fun f -> - try - fields := fn f :: !fields - with - | Exit -> () - ) f - in - let meths = if !is_interface then - List.filter (fun m -> m.moverride = None) ilcls.cmethods - else - ilcls.cmethods - in - run_fields (fun m -> - convert_ilmethod ctx p !is_interface m (List.exists (fun m2 -> m != m2 && String.get m2.mname 0 <> '.' && String.ends_with m2.mname ("." ^ m.mname)) meths) - ) meths; - run_fields (convert_ilfield ctx p) ilcls.cfields; - run_fields (fun prop -> - convert_ilprop ctx p prop (List.exists (fun p2 -> prop != p2 && String.get p2.pname 0 <> '.' && String.ends_with p2.pname ("." ^ prop.pname)) ilcls.cprops) - ) ilcls.cprops; - run_fields (convert_ilevent ctx p) ilcls.cevents; - - let params = List.map (fun p -> - { - tp_name = "T" ^ string_of_int p.tnumber,null_pos; - tp_params = []; - tp_constraints = None; - tp_default = None; - tp_meta = []; - }) ilcls.ctypes - in - - if delegate then begin - (* add op_Addition and op_Subtraction *) - let path = ilcls.cpath in - let thist = mk_type_path ctx path (List.map (fun t -> TPType (mk_type_path ctx ([],[],"T" ^ string_of_int t.tnumber) [],null_pos)) ilcls.ctypes) in - let op name = - { - cff_name = name,null_pos; - cff_doc = None; - cff_pos = p; - cff_meta = []; - cff_access = [APublic,null_pos;AStatic,null_pos]; - cff_kind = FFun { - f_params = params; - f_args = [("arg1",null_pos),false,[],Some (thist,null_pos),None;("arg2",null_pos),false,[],Some (thist,null_pos),None]; - f_type = Some (thist,null_pos); - f_expr = None; - }; - } - in - fields := op "op_Addition" :: op "op_Subtraction" :: !fields; - end; - let path = match ilcls.cpath with - | ns,inner,name when delegate -> - ns,inner,"Delegate_"^name - | _ -> ilcls.cpath - in - let _, c = netpath_to_hx ctx.nstd path in - EClass { - d_name = netname_to_hx c,null_pos; - d_doc = None; - d_params = params; - d_meta = !meta; - d_flags = !flags; - d_data = !fields; - } - -type il_any_field = - | IlField of ilfield - | IlMethod of ilmethod - | IlProp of ilprop - -let get_fname = function - | IlField f -> f.fname - | IlMethod m -> m.mname - | IlProp p -> p.pname - -let is_static = function - | IlField f -> - List.mem CStatic f.fflags.ff_contract - | IlMethod m -> - List.mem CMStatic m.mflags.mf_contract - | IlProp p -> - List.exists (function - | None -> false - | Some (_,m) -> List.mem CMStatic m.mf_contract - ) [p.pget;p.pset] - (* | _ -> false *) - -let change_name name = function - | IlField f -> IlField { f with fname = name } - | IlMethod m -> IlMethod { m with mname = name } - | IlProp p -> IlProp { p with pname = name } - -let compatible_methods m1 m2 = match m1,m2 with - | IlMethod { msig = { snorm = LMethod(_,ret1,args1) } }, IlMethod { msig = { snorm = LMethod(_,ret2,args2) } } -> - ret1 = ret2 && args1 = args2 - | _ -> false - -let ilcls_from_ilsig ctx ilsig = - let path, params = match ilsig with - | LClass(path, params) | LValueType(path, params) -> - path, params - | LObject -> - (["System"],[],"Object"),[] - | _ -> raise Not_found (* all other types won't appear as superclass *) - in - match lookup_ilclass ctx.nstd ctx.ncom path with - | None -> raise Not_found - | Some c -> - c, params - -let rec ilapply_params params = function - | LManagedPointer s -> LManagedPointer (ilapply_params params s) - | LPointer s -> LPointer (ilapply_params params s) - | LValueType (p,pl) -> LValueType(p, List.map (ilapply_params params) pl) - | LClass (p,pl) -> LClass(p, List.map (ilapply_params params) pl) - | LTypeParam i -> - List.nth params i (* TODO: maybe i - 1? *) - | LVector s -> LVector (ilapply_params params s) - | LArray (s,a) -> LArray (ilapply_params params s, a) - | LMethod (c,r,args) -> LMethod (c, ilapply_params params r, List.map (ilapply_params params) args) - | p -> p - -let ilcls_with_params ctx cls params = - match cls.ctypes with - | [] -> cls - | _ -> - { cls with - cfields = List.map (fun f -> { f with fsig = { f.fsig with snorm = ilapply_params params f.fsig.snorm } }) cls.cfields; - cmethods = List.map (fun m -> { m with - msig = { m.msig with snorm = ilapply_params params m.msig.snorm }; - margs = List.map (fun (n,f,s) -> (n,f,{ s with snorm = ilapply_params params s.snorm })) m.margs; - mret = { m.mret with snorm = ilapply_params params m.mret.snorm }; - }) cls.cmethods; - cprops = List.map (fun p -> { p with psig = { p.psig with snorm = ilapply_params params p.psig.snorm } }) cls.cprops; - csuper = Option.map (fun s -> { s with snorm = ilapply_params params s.snorm } ) cls.csuper; - cimplements = List.map (fun s -> { s with snorm = ilapply_params params s.snorm } ) cls.cimplements; - } - -let rec compatible_params t1 t2 = match t1,t2 with - | LManagedPointer(s1), LManagedPointer(s2) -> compatible_params s1 s2 - | LManagedPointer(s1), s2 | s1, LManagedPointer(s2) -> - compatible_params s1 s2 - | _ -> t1 = t2 - -let compatible_methods m1 m2 = match m1, m2 with - | LMethod(_,r1,a1), LMethod(_,r2,a2) -> (try - List.for_all2 (fun a1 a2 -> compatible_params a1 a2) a1 a2 - with | Invalid_argument _ -> - false) - | _ -> false - -let compatible_field f1 f2 = match f1, f2 with - | IlMethod { msig = { snorm = LMethod(_,_,a1) } }, - IlMethod { msig = { snorm = LMethod(_,_,a2) } } -> - a1 = a2 - | IlProp p1, IlProp p2 -> - (* p1.psig.snorm = p2.psig.snorm *) - true - | IlField f1, IlField f2 -> - (* f1.fsig.snorm = f2.fsig.snorm *) - true - | _ -> false - -let get_all_fields cls = - let all_fields = List.map (fun f -> IlField f, cls.cpath, f.fname, List.mem CStatic f.fflags.ff_contract) cls.cfields in - let all_fields = all_fields @ List.map (fun m -> IlMethod m, cls.cpath, m.mname, List.mem CMStatic m.mflags.mf_contract) cls.cmethods in - let all_fields = all_fields @ List.map (fun p -> IlProp p, cls.cpath, p.pname, is_static (IlProp p)) cls.cprops in - all_fields - -let normalize_ilcls ctx cls = - let force_check = Common.defined ctx.ncom Define.ForceLibCheck in - (* first filter out overloaded fields of same signature *) - let rec loop acc = function - | [] -> acc - | m :: cmeths -> - let static = List.mem CMStatic m.mflags.mf_contract in - if List.exists (fun m2 -> m.mname = m2.mname && List.mem CMStatic m2.mflags.mf_contract = static && compatible_methods m.msig.snorm m2.msig.snorm) cmeths then - loop acc cmeths - else - loop (m :: acc) cmeths - in - let meths = loop [] cls.cmethods in - (* fix overrides *) - (* get only the methods that aren't declared as override, but may be *) - let meths = List.map (fun v -> ref v) meths in - let no_overrides = List.filter (fun m -> - let m = !m in - not (List.mem CMStatic m.mflags.mf_contract) - ) meths in - let no_overrides = ref no_overrides in - - let all_fields = ref [] in - let all_events_name = Hashtbl.create 0 in - (* avoid naming collision between events and functions *) - let add_cls_events_collision cls = - List.iter (fun m -> if not (List.mem CMStatic m.mflags.mf_contract) then Hashtbl.replace all_events_name m.mname true) cls.cmethods; - List.iter (fun p -> if not (is_static (IlProp p)) then Hashtbl.replace all_events_name p.pname true) cls.cprops; - in - - let rec loop cls = try - match cls.csuper with - | Some { snorm = LClass((["System"],[],"Object"),_) } - | Some { snorm = LObject } -> - let cls, params = ilcls_from_ilsig ctx LObject in - let cls = ilcls_with_params ctx cls params in - all_fields := get_all_fields cls @ !all_fields; - | None -> () - | Some s -> - let cls, params = ilcls_from_ilsig ctx s.snorm in - let cls = ilcls_with_params ctx cls params in - if force_check then no_overrides := List.filter (fun v -> - let m = !v in - let is_override_here = List.exists (fun m2 -> - m2.mname = m.mname && not (List.mem CMStatic m2.mflags.mf_contract) && compatible_methods m.msig.snorm m2.msig.snorm - ) cls.cmethods in - if is_override_here then v := { m with moverride = Some(cls.cpath, m.mname) }; - not is_override_here - ) !no_overrides; - all_fields := get_all_fields cls @ !all_fields; - - add_cls_events_collision cls; - List.iter (fun ev -> Hashtbl.replace all_events_name ev.ename true) cls.cevents; - - loop cls - with | Not_found -> () - in - loop cls; - - add_cls_events_collision cls; - if force_check then List.iter (fun v -> v := { !v with moverride = None }) !no_overrides; - let added = ref [] in - - let current_all = ref (get_all_fields cls @ !all_fields) in - (* look for interfaces and add missing implementations (some methods' implementation is optional) *) - let rec loop_interface cls iface = try - match iface.snorm with - | LClass((["System"],[],"Object"),_) | LObject -> () - | LClass(path,_) when path = cls.cpath -> () - | s -> - let cif, params = ilcls_from_ilsig ctx s in - let cif = ilcls_with_params ctx cif params in - List.iter (function - | (f,_,name,false) as ff -> - (* look for compatible fields *) - if not (List.exists (function - | (f2,_,name2,false) when (name = name2 || String.ends_with name2 ("." ^ name)) -> (* consider explicit implementations as implementations *) - compatible_field f f2 - | _ -> false - ) !current_all) then begin - current_all := ff :: !current_all; - added := ff :: !added - end else - (* ensure it's public *) - List.iter (fun mref -> match !mref with - | m when m.mname = name && compatible_field f (IlMethod m) -> - mref := { m with mflags = { m.mflags with mf_access = FAPublic } } - | _ -> () - ) meths - | _ -> () - ) (get_all_fields cif); - List.iter (loop_interface cif) cif.cimplements - with | Not_found -> () - in - if not (List.mem SAbstract cls.cflags.tdf_semantics) then List.iter (loop_interface cls) cls.cimplements; - let added = List.map (function - | (IlMethod m,a,name,b) when m.mflags.mf_access <> FAPublic -> - (IlMethod { m with mflags = { m.mflags with mf_access = FAPublic } },a,name,b) - | (IlField f,a,name,b) when f.fflags.ff_access <> FAPublic -> - (IlField { f with fflags = { f.fflags with ff_access = FAPublic } },a,name,b) - | s -> s - ) !added in - - (* filter out properties that were already declared *) - let props = if force_check then List.filter (function - | p -> - let static = is_static (IlProp p) in - let name = p.pname in - not (List.exists (function (IlProp _,_,n,s) -> s = static && name = n | _ -> false) !all_fields) - (* | _ -> false *) - ) cls.cprops - else - cls.cprops - in - let cls = { cls with cmethods = List.map (fun v -> !v) meths; cprops = props } in - - let clsfields = (get_all_fields cls) @ added in - let super_fields = !all_fields in - all_fields := clsfields @ !all_fields; - let refclsfields = (List.map (fun v -> ref v) clsfields) in - (* search static / non-static name clash *) - (* change field name to not collide with haxe keywords *) - let fold_field acc v = - let f, p, name, is_static = !v in - let change, copy = match name with - | _ when is_haxe_keyword name -> - true, false - | _ -> - ((is_static && List.exists (function | (f,_,n,false) -> name = n | _ -> false) !all_fields) || - (not is_static && match f with (* filter methods that have the same name as fields *) - | IlMethod _ -> - List.exists (function | ( (IlProp _ | IlField _),_,n,false) -> name = n | _ -> false) super_fields || - List.exists (function | ( (IlProp _ | IlField _),_,n,s) -> name = n | _ -> false) clsfields - | _ -> false)), true - in - if change then begin - let name = "%" ^ name in - let changed = change_name name f, p, name, is_static in - if not copy then - v := changed; - if copy then - v :: ref changed :: acc - else - v :: acc - end else - v :: acc - in - let refclsfields = List.fold_left fold_field [] refclsfields in - - let fold (fields,methods,props) f = match !f with - | IlField f,_,_,_ -> f :: fields,methods,props - | IlMethod m,_,_,_ -> fields,m :: methods,props - | IlProp p,_,_,_ -> fields,methods,p :: props - in - let fields, methods, props = List.fold_left fold ([],[],[]) refclsfields in - { cls with - cfields = fields; - cprops = props; - cmethods = methods; - cevents = List.filter (fun ev -> not (Hashtbl.mem all_events_name ev.ename)) cls.cevents; - } - -let add_net_std com file = - com.net_std <- file :: com.net_std - -class net_library com name file_path std = object(self) - inherit [net_lib_type,unit] native_library name file_path - - val mutable ilctx = None - val cache = Hashtbl.create 0 - - method private netpath_to_hx = - netpath_to_hx std - - method load = - let r = PeReader.create_r (open_in_bin file_path) com.defines.Define.values in - let ctx = PeReader.read r in - let clr_header = PeReader.read_clr_header ctx in - let cache = IlMetaReader.create_cache () in - let meta = IlMetaReader.read_meta_tables ctx clr_header cache in - close_in (r.PeReader.ch); - if Common.raw_defined com "net_loader_debug" then - print_endline ("for lib " ^ file_path); - let il_typedefs = Hashtbl.copy meta.il_typedefs in - Hashtbl.clear meta.il_typedefs; - - Hashtbl.iter (fun _ td -> - let path = IlMetaTools.get_path (TypeDef td) in - if Common.raw_defined com "net_loader_debug" then - Printf.printf "found %s\n" (s_type_path (self#netpath_to_hx path)); - Hashtbl.replace com.net_path_map (self#netpath_to_hx path) path; - Hashtbl.replace meta.il_typedefs path td - ) il_typedefs; - let meta = { nstd = std; ncom = com; nil = meta } in - ilctx <- Some meta - - method get_ctx = match ilctx with - | None -> - self#load; - self#get_ctx - | Some ctx -> - ctx - - method close = - () - - method list_modules = - Hashtbl.fold (fun path _ acc -> match path with - | _,_ :: _, _ -> acc - | _ -> self#netpath_to_hx path :: acc) (self#get_ctx).nil.il_typedefs [] - - method lookup path : net_lib_type = - try - Hashtbl.find cache path - with | Not_found -> try - let ctx = self#get_ctx in - let ns, n, cl = hxpath_to_net ctx path in - let cls = IlMetaTools.convert_class ctx.nil (ns,n,cl) in - let cls = normalize_ilcls ctx cls in - Hashtbl.add cache path (Some cls); - Some cls - with | Not_found -> - Hashtbl.add cache path None; - None - - method build (path : path) (p : pos) : Ast.package option = - let p = { pfile = file_path ^ " @ " ^ s_type_path path; pmin = 0; pmax = 0; } in - let pack = match fst path with | ["haxe";"root"] -> [] | p -> p in - let cp = ref [] in - let rec build path = try - if Common.raw_defined com "net_loader_debug" then - Printf.printf "looking up %s\n" (s_type_path path); - match self#lookup path with - | Some({csuper = Some{snorm = LClass( (["System"],[],("Delegate"|"MulticastDelegate")),_)}} as cls) - when List.mem SSealed cls.cflags.tdf_semantics -> - let ctx = self#get_ctx in - let hxcls = convert_ilclass ctx p ~delegate:true cls in - let delegate = convert_delegate ctx p cls in - cp := (hxcls,p) :: (delegate,p) :: !cp; - List.iter (fun ilpath -> - let path = netpath_to_hx std ilpath in - build path - ) cls.cnested - | Some cls when not (is_compiler_generated cls) -> - let ctx = self#get_ctx in - let hxcls = convert_ilclass ctx p cls in - cp := (hxcls,p) :: !cp; - List.iter (fun ilpath -> - let path = netpath_to_hx std ilpath in - build path - ) cls.cnested - | _ -> () - with | Not_found | Exit -> - () - in - build path; - match !cp with - | [] -> None - | cp -> Some (pack,cp) - - method get_data = () - - initializer - if std then self#add_flag FlagIsStd -end - -let add_net_lib com file std extern = - let real_file = if Sys.file_exists file then - file - else try Common.find_file com file with - | Not_found -> try Common.find_file com (file ^ ".dll") with - | Not_found -> - failwith (".NET lib " ^ file ^ " not found") - in - let net_lib = new net_library com file real_file std in - if extern then net_lib#add_flag FlagIsExtern; - com.native_libs.net_libs <- (net_lib :> (net_lib_type,unit) native_library) :: com.native_libs.net_libs; - CommonCache.handle_native_lib com net_lib - -let before_generate com = - (* netcore version *) - let netcore_ver = try Some(Common.defined_value com Define.NetcoreVer) with Not_found -> None in - - (* net version *) - let net_ver = - try - let ver = Common.defined_value com Define.NetVer in - try int_of_string ver with Failure _ -> raise (Arg.Bad "Invalid value for -D net-ver. Expected format: xx (e.g. 20, 35, 40, 45, 50)") - with Not_found when netcore_ver != None -> - (* 4.7 was released around .NET core 2.1 *) - (* Note: better version mapping should be implemented some day, - * unless we just wait for .NET unification in october 2020 *) - Common.define_value com Define.NetVer "47"; - 47 - | Not_found -> - Common.define_value com Define.NetVer "20"; - 20 - in - if net_ver < 20 then - failwith ( - ".NET version is defined to target .NET " - ^ string_of_int net_ver - ^ ", but the compiler can only output code to versions equal or superior to .NET 2.0 (defined as 20)" - ); - let rec loop = function - | v :: acc when v <= net_ver -> - Common.raw_define com ("NET_" ^ string_of_int v); - loop acc - | _ -> () - in - loop [20;21;30;35;40;45;50]; - - (* net target *) - let net_target = try - String.lowercase (Common.defined_value com Define.NetTarget) - with | Not_found -> - "net" - in - Common.define_value com Define.NetTarget net_target; - Common.raw_define com net_target; - - (* std dirs *) - let stds = match com.net_std with - | [] -> ["netlib"] - | s -> s - in - (* look for all dirs that have the digraph NET_TARGET-NET_VER *) - let digraph = match net_target with - | "netcore" -> - (match netcore_ver with - | None -> failwith (".NET target is defined as netcore but -D netcore-ver is missing"); - | Some(ver) -> net_target ^ "-" ^ ver); - | _ -> net_target ^ "-" ^ string_of_int net_ver in - - let matched = ref [] in - List.iter (fun f -> try - let f = Common.find_file com (f ^ "/" ^ digraph) in - matched := (f, Unix.opendir f) :: !matched - with | _ -> ()) stds; - - if !matched = [] then failwith ( - "No .NET std lib directory with the pattern '" ^ digraph ^ "' was found in the -net-std search path. " ^ - "Try updating the hxcs lib to the latest version, or specifying another -net-std path."); - List.iter (fun (path,f) -> - let rec loop () = - try - let f = Unix.readdir f in - let finsens = String.lowercase f in - if String.ends_with finsens ".dll" then - add_net_lib com (path ^ "/" ^ f) true false (); - loop() - with | End_of_file -> - Unix.closedir f - in - loop() - ) !matched diff --git a/src/codegen/gencommon/abstractImplementationFix.ml b/src/codegen/gencommon/abstractImplementationFix.ml deleted file mode 100644 index 6009026dd66..00000000000 --- a/src/codegen/gencommon/abstractImplementationFix.ml +++ /dev/null @@ -1,43 +0,0 @@ -(* - The Haxe Compiler - Copyright (C) 2005-2019 Haxe Foundation - - This program is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License - as published by the Free Software Foundation; either version 2 - of the License, or (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. -*) -open Type -open Gencommon - -(** add abstract type parameters to abstract implementation methods *) -let add_abstract_params = function - | TClassDecl ({ cl_kind = KAbstractImpl a } as c) -> - List.iter ( - function - | ({ cf_name = "_new" } as cf) -> - cf.cf_params <- cf.cf_params @ a.a_params - | cf when has_class_field_flag cf CfImpl -> - (match cf.cf_expr with - | Some({ eexpr = TFunction({ tf_args = (v, _) :: _ }) }) when Meta.has Meta.This v.v_meta -> - cf.cf_params <- cf.cf_params @ a.a_params - | _ -> ()) - | _ -> () - ) c.cl_ordered_statics - | _ -> () - -let name = "abstract_implementation_fix" -let priority = solve_deps name [] - -let configure gen = - let run md = (add_abstract_params md; md) in - gen.gmodule_filters#add name (PCustom priority) run diff --git a/src/codegen/gencommon/arrayDeclSynf.ml b/src/codegen/gencommon/arrayDeclSynf.ml deleted file mode 100644 index 605e4e243b7..00000000000 --- a/src/codegen/gencommon/arrayDeclSynf.ml +++ /dev/null @@ -1,51 +0,0 @@ -(* - The Haxe Compiler - Copyright (C) 2005-2019 Haxe Foundation - - This program is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License - as published by the Free Software Foundation; either version 2 - of the License, or (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. -*) -open Type -open Gencommon - -(* - A syntax filter that will change array declarations to the actual native array declarations plus - the haxe array initialization - - dependencies: - Must run after ObjectDeclMap since it can add TArrayDecl expressions -*) -let init (native_array_cl : tclass) (change_type_params : module_type -> t list -> t list) = - let rec run e = - match e.eexpr with - | TArrayDecl el -> - let cl, params = match follow e.etype with - | TInst(({ cl_path = ([], "Array") } as cl), ( _ :: _ as params)) -> cl, params - | TInst(({ cl_path = ([], "Array") } as cl), []) -> cl, [t_dynamic] - | _ -> Globals.die "" __LOC__ - in - let params = change_type_params (TClassDecl cl) params in - let e_inner_decl = mk (TArrayDecl (List.map run el)) (TInst (native_array_cl, params)) e.epos in - mk (TNew (cl, params, [e_inner_decl])) e.etype e.epos - | _ -> - Type.map_expr run e - in - run - -let name = "array_decl_synf" -let priority = solve_deps name [DAfter ObjectDeclMap.priority] - -let configure gen native_array_cl change_type_params = - let run = init native_array_cl change_type_params in - gen.gsyntax_filters#add name (PCustom priority) run diff --git a/src/codegen/gencommon/arraySpliceOptimization.ml b/src/codegen/gencommon/arraySpliceOptimization.ml deleted file mode 100644 index 0abeddb94c2..00000000000 --- a/src/codegen/gencommon/arraySpliceOptimization.ml +++ /dev/null @@ -1,40 +0,0 @@ -open Common -open Type -open Gencommon - -(* - This filter finds lone array.splice(...) calls within blocks - and replaces them with array.spliceVoid(...) calls - that don't allocate additional array for removed items. -*) -let init com = - let rec run e = - match e.eexpr with - | TBlock el -> - let el = List.map (fun e -> - match e.eexpr with - | TCall ({ eexpr = TField (eobj, FInstance ({ cl_path = [],"Array" } as cl, params, { cf_name = "splice" })) } as e_splice, args) -> - let f_spliceVoid = PMap.find "spliceVoid" cl.cl_fields in - let e_spliceVoid = { e_splice with - eexpr = TField (eobj, FInstance (cl, params, f_spliceVoid)); - etype = f_spliceVoid.cf_type; - } in - { e with - eexpr = TCall (e_spliceVoid, args); - etype = com.basic.tvoid; - } - | _ -> - run e - ) el in - { e with eexpr = TBlock el } - | _ -> - Type.map_expr run e - in - run - -let name = "array_splice_synf" -let priority = solve_deps name [DAfter ExpressionUnwrap.priority] - -let configure gen = - let run = init gen.gcon in - gen.gsyntax_filters#add name (PCustom priority) run diff --git a/src/codegen/gencommon/castDetect.ml b/src/codegen/gencommon/castDetect.ml deleted file mode 100644 index 1c0981ff55a..00000000000 --- a/src/codegen/gencommon/castDetect.ml +++ /dev/null @@ -1,1348 +0,0 @@ -(* - The Haxe Compiler - Copyright (C) 2005-2019 Haxe Foundation - - This program is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License - as published by the Free Software Foundation; either version 2 - of the License, or (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. -*) -open Option -open Common -open Ast -open Globals -open Type -open Gencommon - -(* ******************************************* *) -(* Casts detection v2 *) -(* ******************************************* *) -(* - Will detect implicit casts and add TCast for them. Since everything is already followed by follow_all, typedefs are considered a new type altogether - - Types shouldn't be cast if: - * When an instance is being coerced to a superclass or to an implemented interface - * When anything is being coerced to Dynamic - - edit: - As a matter of performance, we will also run the type parameters casts in here. Otherwise the exact same computation would have to be performed twice, - with maybe even some loss of information - - * TAnon / TDynamic will call - * Type parameter handling will be abstracted - - dependencies: - Must run before ExpressionUnwrap - -*) -let name = "cast_detect" -let priority = solve_deps name [DBefore RealTypeParams.priority; DBefore ExpressionUnwrap.priority] - -(* ******************************************* *) -(* ReturnCast *) -(* ******************************************* *) -(* - Cast detection for return types can't be done at CastDetect time, since we need an - unwrapped expression to make sure we catch all return cast detections. So this module - is specifically to deal with that, and is configured automatically by CastDetect -*) -module ReturnCast = -struct - let name = "return_cast" - let priority = solve_deps name [DAfter priority; DAfter ExpressionUnwrap.priority] - - let default_implementation gen = - let rec extract_expr e = match e.eexpr with - | TParenthesis e - | TMeta (_,e) - | TCast(e,_) -> extract_expr e - | _ -> e - in - let current_ret_type = ref None in - let handle e tto tfrom = gen.ghandle_cast (gen.greal_type tto) (gen.greal_type tfrom) e in - let in_value = ref false in - let binop_right_expr_type op actual_type = - match op with - | OpShr | OpShl | OpUShr | OpAssignOp (OpShr | OpShl | OpUShr) -> - (match follow actual_type with - | TAbstract ({ a_path = (["cs"], "Int64") }, _) -> gen.gcon.basic.tint - | _ -> actual_type) - | _ -> actual_type - in - - let rec run e = - let was_in_value = !in_value in - in_value := true; - match e.eexpr with - | TReturn (eopt) -> - (* a return must be inside a function *) - let ret_type = match !current_ret_type with | Some(s) -> s | None -> gen.gcon.error "Invalid return outside function declaration." e.epos; die "" __LOC__ in - (match eopt with - | None when not (ExtType.is_void ret_type) -> - Texpr.Builder.mk_return (null ret_type e.epos) - | None -> e - | Some eret -> - Texpr.Builder.mk_return (handle (run eret) ret_type eret.etype)) - | TFunction(tfunc) -> - let last_ret = !current_ret_type in - current_ret_type := Some(tfunc.tf_type); - let ret = Type.map_expr run e in - current_ret_type := last_ret; - ret - | TBlock el -> - { e with eexpr = TBlock ( List.map (fun e -> in_value := false; run e) el ) } - | TBinop ( (Ast.OpAssign as op),e1,e2) - | TBinop ( (Ast.OpAssignOp _ as op),e1,e2) when was_in_value -> - let e1 = extract_expr (run e1) in - let r = { e with eexpr = TBinop(op, e1, handle (run e2) e1.etype e2.etype); etype = e1.etype } in - handle r e.etype e1.etype - | TBinop ( (Ast.OpAssign as op),({ eexpr = TField(tf, f) } as e1), e2 ) - | TBinop ( (Ast.OpAssignOp _ as op),({ eexpr = TField(tf, f) } as e1), e2 ) -> - (match field_access_esp gen (gen.greal_type tf.etype) (f) with - | FClassField(cl,params,_,_,is_static,actual_t,_) -> - let actual_t = if is_static then actual_t else apply_params cl.cl_params params actual_t in - let actual_t = binop_right_expr_type op actual_t in - let e1 = extract_expr (run e1) in - { e with eexpr = TBinop(op, e1, handle (run e2) actual_t e2.etype); etype = e1.etype } - | _ -> - let e1 = extract_expr (run e1) in - let actual_t = binop_right_expr_type op e2.etype in - { e with eexpr = TBinop(op, e1, handle (run e2) e1.etype actual_t); etype = e1.etype } - ) - | TBinop ( (Ast.OpAssign as op),e1,e2) - | TBinop ( (Ast.OpAssignOp _ as op),e1,e2) -> - let e1 = extract_expr (run e1) in - let actual_t = binop_right_expr_type op e2.etype in - { e with eexpr = TBinop(op, e1, handle (run e2) e1.etype actual_t); etype = e1.etype } - | _ -> Type.map_expr run e - in - run - - let configure gen = - let map = default_implementation gen in - gen.gsyntax_filters#add name (PCustom priority) map -end;; - -(* - Since this function is applied under native-context only, the type paraters will already be changed -*) -let map_cls gen also_implements fn super = - let rec loop c tl = - if c == super then - fn c tl - else - (match c.cl_super with - | None -> false - | Some (cs,tls) -> - let tls = gen.greal_type_param (TClassDecl cs) tls in - loop cs (List.map (apply_params c.cl_params tl) tls) - ) - || - (if also_implements then - List.exists (fun (cs,tls) -> loop cs (List.map (apply_params c.cl_params tl) tls)) c.cl_implements - else - false) - in - loop - -let follow_dyn t = match follow t with - | TMono _ | TLazy _ -> t_dynamic - | t -> t - -(* - this has a slight change from the type.ml version, in which it doesn't - change a TMono into the other parameter -*) -let rec type_eq gen param a b = - if a == b then - () - else match follow_dyn (gen.greal_type a) , follow_dyn (gen.greal_type b) with - | TEnum (e1,tl1) , TEnum (e2,tl2) -> - if e1 != e2 && not (param = EqCoreType && e1.e_path = e2.e_path) then Type.error [cannot_unify a b]; - List.iter2 (type_eq gen param) tl1 tl2 - | TAbstract (a1,tl1) , TAbstract (a2,tl2) -> - if a1 != a2 && not (param = EqCoreType && a1.a_path = a2.a_path) then Type.error [cannot_unify a b]; - List.iter2 (type_eq gen param) tl1 tl2 - | TInst (c1,tl1) , TInst (c2,tl2) -> - if c1 != c2 && not (param = EqCoreType && c1.cl_path = c2.cl_path) && (match c1.cl_kind, c2.cl_kind with KExpr _, KExpr _ -> false | _ -> true) then Type.error [cannot_unify a b]; - List.iter2 (type_eq gen param) tl1 tl2 - | TFun (l1,r1) , TFun (l2,r2) when List.length l1 = List.length l2 -> - (try - type_eq gen param r1 r2; - List.iter2 (fun (n,o1,t1) (_,o2,t2) -> - if o1 <> o2 then Type.error [Not_matching_optional n]; - type_eq gen param t1 t2 - ) l1 l2 - with - Unify_error l -> Type.error (cannot_unify a b :: l)) - | TDynamic None , TDynamic None -> - () - | TDynamic (Some a) , TDynamic (Some b) -> - type_eq gen param a b - | TAnon a1, TAnon a2 -> - (try - 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 ~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 - Unify_error l -> Type.error (invalid_field n :: l) - with - Not_found -> - Type.error [has_no_field b n]; - ) a1.a_fields; - PMap.iter (fun n f2 -> - if not (PMap.mem n a1.a_fields) then begin - Type.error [has_no_field a n]; - end; - ) a2.a_fields; - with - Unify_error l -> Type.error (cannot_unify a b :: l)) - | _ , _ -> - if b == t_dynamic && (param = EqRightDynamic || param = EqBothDynamic) then - () - else if a == t_dynamic && param = EqBothDynamic then - () - else - Type.error [cannot_unify a b] - -let type_iseq gen a b = - try - type_eq gen EqStrict a b; - true - with - Unify_error _ -> false - -(* will return true if both arguments are compatible. If it's not the case, a runtime error is very likely *) -let is_cl_related gen cl tl super superl = - let is_cl_related cl tl super superl = map_cls gen (match cl.cl_kind,super.cl_kind with KTypeParameter _, _ | _,KTypeParameter _ -> false | _ -> true) (fun _ _ -> true) super cl tl in - is_cl_related cl tl super superl || is_cl_related super superl cl tl - -let is_exactly_basic gen t1 t2 = - match gen.gfollow#run_f t1, gen.gfollow#run_f t2 with - | TAbstract(a1, []), TAbstract(a2, []) -> - a1 == a2 && Common.defined gen.gcon Define.FastCast - | TInst(c1, []), TInst(c2, []) -> - c1 == c2 && Common.defined gen.gcon Define.FastCast - | TEnum(e1, []), TEnum(e2, []) -> - e1 == e2 && Common.defined gen.gcon Define.FastCast - | _ -> - false - -let is_unsafe_cast gen to_t from_t = - match (follow to_t, follow from_t) with - | TInst(cl_to, to_params), TInst(cl_from, from_params) -> - not (is_cl_related gen cl_from from_params cl_to to_params) - | TEnum(e_to, _), TEnum(e_from, _) -> - e_to.e_path <> e_from.e_path - | TFun _, TFun _ -> - (* functions are never unsafe cast by default. This behavior might be changed *) - (* with a later AST pass which will run through TFun to TFun casts *) - false - | TMono _, _ - | _, TMono _ - | TDynamic _, _ - | _, TDynamic _ -> - false - | TAnon _, _ - | _, TAnon _ -> - (* anonymous are never unsafe also. *) - (* Though they will generate a cast, so if this cast is unneeded it's better to avoid them by tweaking gen.greal_type *) - false - | TAbstract _, _ - | _, TAbstract _ -> - (try - unify from_t to_t; - false - with | Unify_error _ -> - try - unify to_t from_t; (* still not unsafe *) - false - with | Unify_error _ -> - true) - | _ -> true - -let unifies tfrom tto = try - unify tfrom tto; - true -with | _ -> - false - -let do_unsafe_cast gen from_t to_t e = - let t_path t = - match t with - | TInst(cl, _) -> cl.cl_path - | TEnum(e, _) -> e.e_path - | TType(t, _) -> t.t_path - | TAbstract(a, _) -> a.a_path - | TDynamic _ -> ([], "Dynamic") - | _ -> raise Not_found - in - match gen.gfollow#run_f from_t, gen.gfollow#run_f to_t with - | TInst({ cl_kind = KTypeParameter ttp },_), t2 when List.exists (fun t -> unifies t t2) (get_constraints ttp) -> - mk_cast to_t (mk_cast t_dynamic e) - | from_t, to_t when gen.gspecial_needs_cast to_t from_t -> - mk_cast to_t e - | _ -> - let do_default () = - gen.gon_unsafe_cast to_t e.etype e.epos; - mk_cast to_t (mk_cast t_dynamic e) - in - (* TODO: there really should be a better way to write that *) - try - if (Hashtbl.find gen.gsupported_conversions (t_path from_t)) from_t to_t then - mk_cast to_t e - else - do_default() - with - | Not_found -> - try - if (Hashtbl.find gen.gsupported_conversions (t_path to_t)) from_t to_t then - mk_cast to_t e - else - do_default() - with - | Not_found -> do_default() - -(* ****************************** *) -(* cast handler *) -(* decides if a cast should be emitted, given a from and a to type *) -(* - this function is like a mini unify, without e.g. subtyping, which makes sense - at the backend level, since most probably Anons and TInst will have a different representation there -*) -let rec handle_cast gen e real_to_t real_from_t = - let do_unsafe_cast () = do_unsafe_cast gen real_from_t real_to_t { e with etype = real_from_t } in - let to_t, from_t = real_to_t, real_from_t in - - let mk_cast fast t e = - match e.eexpr with - (* TThrow is always typed as Dynamic, we just need to type it accordingly *) - | TThrow _ -> { e with etype = t } - | _ -> if fast then mk_castfast t e else mk_cast t e - in - - let e = { e with etype = real_from_t } in - if try fast_eq real_to_t real_from_t with Invalid_argument _ -> false then e else - match real_to_t, real_from_t with - (* string is the only type that can be implicitly converted from any other *) - | TInst( { cl_path = ([], "String") }, []), TInst( { cl_path = ([], "String") }, [] ) -> - mk_cast true to_t e - | TInst( { cl_path = ([], "String") }, []), _ -> - mk_cast false to_t e - | TInst( ({ cl_path = (["cs"|"java"], "NativeArray") } as c_array), [tp_to] ), TInst({ cl_path = (["cs"|"java"], "NativeArray") }, [tp_from]) when not (type_iseq gen (gen.greal_type tp_to) (gen.greal_type tp_from)) -> - (* see #5751 . NativeArray is special because of its ties to Array. We could potentially deal with this for all *) - (* TNew expressions, but it's not that simple, since we don't want to retype the whole expression list with the *) - (* updated type. *) - (match e.eexpr with - | TNew(c,_,el) when c == c_array -> - mk_cast false (TInst(c_array,[tp_to])) { e with eexpr = TNew(c, [tp_to], el); etype = TInst(c_array,[tp_to]) } - | _ -> - e - ) - | TInst(cl_to, params_to), TInst(cl_from, params_from) -> - let ret = ref None in - (* - this is a little confusing: - we are here mapping classes until we have the same to and from classes, applying the type parameters in each step, so we can - compare the type parameters; - - If a class is found - meaning that the cl_from can be converted without a cast into cl_to, - we still need to check their type parameters. - *) - ignore (map_cls gen (match cl_from.cl_kind,cl_to.cl_kind with KTypeParameter _, _ | _,KTypeParameter _ -> false | _ -> true) (fun _ tl -> - try - (* type found, checking type parameters *) - List.iter2 (type_eq gen EqStrict) tl params_to; - ret := Some e; - true - with | Unify_error _ -> - (* type parameters need casting *) - if gen.ghas_tparam_cast_handler then begin - (* - if we are already handling type parameter casts on other part of code (e.g. RealTypeParameters), - we'll just make a cast to indicate that this place needs type parameter-involved casting - *) - ret := Some (mk_cast true to_t e); - true - end else - (* - if not, we're going to check if we only need a simple cast, - or if we need to first cast into the dynamic version of it - *) - try - List.iter2 (type_eq gen EqRightDynamic) tl params_to; - ret := Some (mk_cast true to_t e); - true - with | Unify_error _ -> - ret := Some (mk_cast true to_t (mk_cast true (TInst(cl_to, List.map (fun _ -> t_dynamic) params_to)) e)); - true - ) cl_to cl_from params_from); - if is_some !ret then - get !ret - else if is_cl_related gen cl_from params_from cl_to params_to then - mk_cast true to_t e - else - (* potential unsafe cast *) - (do_unsafe_cast ()) - | TMono _, TMono _ - | TMono _, TDynamic _ - | TDynamic _, TDynamic _ - | TDynamic _, TMono _ -> - e - | TMono _, _ - | TDynamic _, _ - | TAnon _, _ when gen.gneeds_box real_from_t -> - mk_cast false to_t e - | TMono _, _ - | TDynamic _, _ -> e - | _, TMono _ - | _, TDynamic _ -> mk_cast false to_t e - | TAnon (a_to), TAnon (a_from) -> - if a_to == a_from then - e - else if type_iseq gen to_t from_t then (* FIXME apply unify correctly *) - e - else - mk_cast true to_t e - | _, TAnon(anon) -> (try - let p2 = match !(anon.a_status) with - | ClassStatics c -> TInst(c,List.map (fun _ -> t_dynamic) c.cl_params) - | EnumStatics e -> TEnum(e, List.map (fun _ -> t_dynamic) e.e_params) - | AbstractStatics a -> TAbstract(a, List.map (fun _ -> t_dynamic) a.a_params) - | _ -> raise Not_found - in - let tclass = match get_type gen ([],"Class") with - | TAbstractDecl(a) -> a - | _ -> die "" __LOC__ in - handle_cast gen e real_to_t (gen.greal_type (TAbstract(tclass, [p2]))) - with | Not_found -> - mk_cast false to_t e) - | TAbstract (a_to, _), TAbstract(a_from, _) when a_to == a_from -> - e - | TAbstract _, TInst({ cl_kind = KTypeParameter _ }, _) - | TInst({ cl_kind = KTypeParameter _ }, _), TAbstract _ -> - do_unsafe_cast() - | TAbstract _, _ - | _, TAbstract _ -> - (try - unify from_t to_t; - mk_cast true to_t e - with | Unify_error _ -> - try - unify to_t from_t; - mk_cast true to_t e - with | Unify_error _ -> - do_unsafe_cast()) - | TEnum(e_to, []), TEnum(e_from, []) -> - if e_to == e_from then - e - else - (* potential unsafe cast *) - (do_unsafe_cast ()) - | TEnum(e_to, params_to), TEnum(e_from, params_from) when e_to.e_path = e_from.e_path -> - (try - List.iter2 (type_eq gen (if gen.gallow_tp_dynamic_conversion then EqRightDynamic else EqStrict)) params_from params_to; - e - with - | Unify_error _ -> do_unsafe_cast () - ) - | TEnum(en, params_to), TInst(cl, params_from) - | TInst(cl, params_to), TEnum(en, params_from) -> - (* this is here for max compatibility with EnumsToClass module *) - if en.e_path = cl.cl_path && Meta.has Meta.Class en.e_meta then begin - (try - List.iter2 (type_eq gen (if gen.gallow_tp_dynamic_conversion then EqRightDynamic else EqStrict)) params_from params_to; - e - with - | Invalid_argument _ -> - (* - this is a hack for RealTypeParams. Since there is no way at this stage to know if the class is the actual - EnumsToClass derived from the enum, we need to imply from possible ArgumentErrors (because of RealTypeParams interfaces), - that they would only happen if they were a RealTypeParams created interface - *) - e - | Unify_error _ -> do_unsafe_cast () - ) - end else - do_unsafe_cast () - | TType(t_to, params_to), TType(t_from, params_from) when t_to == t_from -> - if gen.gspecial_needs_cast real_to_t real_from_t then - (try - List.iter2 (type_eq gen (if gen.gallow_tp_dynamic_conversion then EqRightDynamic else EqStrict)) params_from params_to; - e - with - | Unify_error _ -> do_unsafe_cast () - ) - else - e - | TType(t_to, _), TType(t_from,_) -> - if gen.gspecial_needs_cast real_to_t real_from_t then - mk_cast false to_t e - else - e - | TType _, _ when gen.gspecial_needs_cast real_to_t real_from_t -> - mk_cast false to_t e - | _, TType _ when gen.gspecial_needs_cast real_to_t real_from_t -> - mk_cast false to_t e - (*| TType(t_to, _), TType(t_from, _) -> - if t_to.t_path = t_from.t_path then - e - else if is_unsafe_cast gen real_to_t real_from_t then (* is_unsafe_cast will already follow both *) - (do_unsafe_cast ()) - else - mk_cast to_t e*) - | TType _, _ - | _, TType _ -> - if is_unsafe_cast gen real_to_t real_from_t then (* is_unsafe_cast will already follow both *) - (do_unsafe_cast ()) - else - mk_cast false to_t e - | TAnon anon, _ -> - if PMap.is_empty anon.a_fields then - e - else - mk_cast true to_t e - | TFun(args, ret), TFun(args2, ret2) -> - let get_args = List.map (fun (_,_,t) -> t) in - (try List.iter2 (type_eq gen (EqBothDynamic)) (ret :: get_args args) (ret2 :: get_args args2); e with | Unify_error _ | Invalid_argument _ -> mk_cast true to_t e) - | _, _ -> - do_unsafe_cast () - -(* end of cast handler *) -(* ******************* *) - -let is_static_overload c name = - match c.cl_super with - | None -> false - | Some (sup,_) -> - let rec loop c = - (PMap.mem name c.cl_statics) || (match c.cl_super with - | None -> false - | Some (sup,_) -> loop sup) - in - loop sup - -(* this is a workaround for issue #1743, as FInstance() is returning the incorrect classfield *) -let rec clean_t t = match follow t with - | TAbstract(a,tl) when not (Meta.has Meta.CoreType a.a_meta) -> - clean_t (Abstract.get_underlying_type a tl) - | t -> t - -let select_overload gen applied_f overloads types params = - let rec check_arg arglist elist = - match arglist, elist with - | [], [] -> true (* it is valid *) - | (_,_,t) :: [], elist when ExtType.is_rest t -> - (match follow t with - | TAbstract({ a_path = (["haxe"],"Rest") }, [t]) -> - List.for_all (fun (_,_,et) -> Type.type_iseq (clean_t et) (clean_t t)) elist - | _ -> die "" __LOC__) - | (_,_,t) :: arglist, (_,_,et) :: elist when Type.type_iseq (clean_t et) (clean_t t) -> - check_arg arglist elist - | _ -> false - in - match follow applied_f with - | TFun _ -> - replace_mono applied_f; - let args, _ = get_fun applied_f in - let elist = List.rev args in - let rec check_overload overloads = - match overloads with - | (t, cf) :: overloads -> - let cft = apply_params types params t in - let cft = monomorphs cf.cf_params cft in - let args, _ = get_fun cft in - if check_arg (List.rev args) elist then - cf,t,false - else if overloads = [] then - cf,t,true (* no compatible overload was found *) - else - check_overload overloads - | [] -> die "" __LOC__ - in - check_overload overloads - | _ -> match overloads with (* issue #1742 *) - | (t,cf) :: [] -> cf,t,true - | (t,cf) :: _ -> cf,t,false - | _ -> die "" __LOC__ - -let rec cur_ctor c tl = - match c.cl_constructor with - | Some ctor -> - ctor, c, tl - | None -> - match c.cl_super with - | None -> - raise Not_found - | Some (sup,stl) -> - cur_ctor sup (List.map (apply_params c.cl_params tl) stl) - -let choose_ctor gen cl tparams etl maybe_empty_t p = - let ctor, sup, stl = cur_ctor cl tparams in - (* get returned stl, with Dynamic as t_empty *) - let rec get_changed_stl c tl = - if c == sup then - tl - else match c.cl_super with - | None -> stl - | Some(sup,stl) -> get_changed_stl sup (List.map (apply_params c.cl_params tl) stl) - in - let ret_tparams = List.map (fun t -> match follow t with - | TDynamic _ | TMono _ -> t_empty - | _ -> t) tparams - in - let ret_stl = get_changed_stl cl ret_tparams in - let ctors = ctor :: ctor.cf_overloads in - List.iter replace_mono etl; - (* first filter out or select outright maybe_empty *) - let ctors, is_overload = match etl, maybe_empty_t with - | [t], Some empty_t -> - let count = ref 0 in - let is_empty_call = Type.type_iseq t empty_t in - let ret = List.filter (fun cf -> match follow cf.cf_type with - | TFun([_,_,t],_) -> - replace_mono t; incr count; is_empty_call = (Type.type_iseq t empty_t) - | _ -> false) ctors - in - ret, !count > 1 - | _ -> - let len = List.length etl in - let ret = List.filter (fun cf -> List.length (fst (get_fun cf.cf_type)) <= len) ctors in - ret, (match ret with | _ :: [] -> false | _ -> true) - in - let rec check_arg arglist elist = - match arglist, elist with - | [], [] -> true - | [(_,_,t)], elist when ExtType.is_rest (follow t) -> - (match follow t with - | TAbstract ({ a_path = ["haxe"],"Rest" } as a, [t1]) -> - let is_rest_array arg_t = - let boxed = TAbstract (a, [get_boxed gen t1]) in - Type.fast_eq (Abstract.follow_with_abstracts boxed) (Abstract.follow_with_abstracts arg_t) - in - (match elist with - | [arg_t] when is_rest_array arg_t -> true - | _ -> - let t1 = run_follow gen t1 in - (try - List.iter (fun et -> unify et t1) elist; - true - with Unify_error _ -> - false - ) - ) - | _ -> die "" __LOC__ - ) - | (_,_,t) :: arglist, et :: elist -> - (try - let t = run_follow gen t in - unify et t; - check_arg arglist elist - with Unify_error el -> - false - ) - | _ -> - false - in - let check_cf cf = - let t = apply_params sup.cl_params stl cf.cf_type in - replace_mono t; - let args, _ = get_fun t in - check_arg args etl - in - match is_overload, ctors with - | false, [c] -> - false, c, sup, ret_stl - | _ -> - is_overload, List.find check_cf ctors, sup, ret_stl - -let change_rest tfun elist = - let expects_rest_args = ref false in - let rec loop acc arglist elist = match arglist, elist with - | (_,_,t) as arg :: [], elist when ExtType.is_rest t -> - (match elist with - | [{ eexpr = TUnop (Spread,Prefix,e) }] -> - List.rev (arg :: acc) - | _ -> - (match follow t with - | TAbstract({ a_path = (["haxe"],"Rest") },[t1]) -> - let is_rest_array e = - Type.fast_eq (Abstract.follow_with_abstracts t) (Abstract.follow_with_abstracts e.etype) - in - (match elist with - | [e] when is_rest_array e -> - List.rev (("rest",false,t) :: acc) - | _ -> - expects_rest_args := true; - List.rev (List.map (fun _ -> "rest",false,t1) elist @ acc) - ) - | _ -> die "" __LOC__) - ) - | (n,o,t) :: arglist, _ :: elist -> - loop ((n,o,t) :: acc) arglist elist - | _, _ -> - List.rev acc - in - let args,ret = get_fun tfun in - let args_types = loop [] args elist in - !expects_rest_args,TFun(args_types, ret) - -let fastcast_if_needed gen expr real_to_t real_from_t = - if Common.defined gen.gcon Define.FastCast then begin - if type_iseq gen real_to_t real_from_t then - { expr with etype = real_to_t } - else - mk_castfast real_to_t { expr with etype=real_from_t } - end else - handle_cast gen expr real_to_t real_from_t - -(* - Type parameter handling - It will detect if/what type parameters were used, and call the cast handler - It will handle both TCall(TField) and TCall by receiving a texpr option field: e - Also it will transform the type parameters with greal_type_param and make - - handle_impossible_tparam - should cases where the type parameter is impossible to be determined from the called parameters be Dynamic? - e.g. static function test():T {} -*) - -(* match e.eexpr with | TCall( ({ eexpr = TField(ef, f) }) as e1, elist ) -> *) -let handle_type_parameter gen e e1 ef ~clean_ef ~overloads_cast_to_base f elist calls_parameters_explicitly = - (* the ONLY way to know if this call has parameters is to analyze the calling field. *) - (* To make matters a little worse, on both C# and Java only in some special cases that type parameters will be used *) - (* Namely, when using reflection type parameters are useless, of course. This also includes anonymous types *) - (* this will have to be handled by gparam_func_call *) - - let return_var efield = - match e with - | None -> - efield - | Some ecall -> - match follow efield.etype with - | TFun(_,ret) -> - (* closures will be handled by the closure handler. So we will just hint what's the expected type *) - (* FIXME: should closures have also its arguments cast correctly? In the current implementation I think not. TO_REVIEW *) - handle_cast gen { ecall with eexpr = TCall(efield, elist) } (gen.greal_type ecall.etype) ret - | _ -> - { ecall with eexpr = TCall(efield, elist) } - in - - (* this function will receive the original function argument, the applied function argument and the original function parameters. *) - (* from this info, it will infer the applied tparams for the function *) - let infer_params pos (original_args:((string * bool * t) list * t)) (applied_args:((string * bool * t) list * t)) (params:typed_type_param list) calls_parameters_explicitly : tparams = - match params with - | [] -> [] - | _ -> - let args_list args = (if not calls_parameters_explicitly then t_dynamic else snd args) :: (List.map (fun (n,o,t) -> t) (fst args)) in - - let monos = List.map (fun _ -> mk_mono()) params in - let original = args_list (get_fun (apply_params params monos (TFun(fst original_args,snd original_args)))) in - let applied = args_list applied_args in - - (try - List.iter2 (fun a o -> - unify a o - (* type_eq EqStrict a o *) - ) applied original - (* unify applied original *) - with - | Unify_error el -> - (match el with - (* - Don't emit a warning for abstracts if underlying type is the same as the second type. - This situation is caused by `Normalize.filter_param` not "unpacking" abstracts. - *) - | [Cannot_unify (TAbstract(a,params), b)] - | [Cannot_unify (b, TAbstract(a,params))] -> - let a = apply_params a.a_params params a.a_this in - if not (shallow_eq a b) then - gen.gwarning WGenerator ("This expression may be invalid") pos - | _ -> - gen.gwarning WGenerator ("This expression may be invalid") pos - ) - | Invalid_argument _ -> - gen.gwarning WGenerator ("This expression may be invalid") pos - ); - - List.map (fun t -> - match follow_without_null t with - | TMono _ -> t_empty - | t -> t - ) monos - in - - let real_type = gen.greal_type ef.etype in - (* this part was rewritten at roughly r6477 in order to correctly support overloads *) - (match field_access_esp gen real_type (f) with - | FClassField (cl, params, _, cf, is_static, actual_t, declared_t) when e <> None && (cf.cf_kind = Method MethNormal || cf.cf_kind = Method MethInline) -> - (* C# target changes params with a real_type function *) - let params = match follow clean_ef.etype with - | TInst(_,params) -> params - | _ -> params - in - let local_mk_cast t expr = - (* handle_cast gen expr t expr.etype *) - if is_exactly_basic gen t expr.etype then - expr - else - mk_castfast t expr - in - - let ecall = get e in - let ef = ref ef in - let is_overload = cf.cf_overloads <> [] || has_class_field_flag cf CfOverload || (is_static && is_static_overload cl (field_name f)) in - let cf, actual_t, error = match is_overload with - | false -> - (* since actual_t from FClassField already applies greal_type, we're using the get_overloads helper to get this info *) - let t = if cf.cf_params = [] then (* this if statement must be eliminated - it's a workaround for #3516 + infer params. *) - actual_t - else - declared_t - in - cf,t,false - | true -> - let (cf, actual_t, error), is_static = match f with - | FInstance(c,_,cf) | FClosure(Some (c,_),cf) -> - (* get from overloads *) - (* FIXME: this is a workaround for issue #1743 . Uncomment this code after it was solved *) - (* let t, cf = List.find (fun (t,cf2) -> cf == cf2) (Overloads.get_overloads cl (field_name f)) in *) - (* cf, t, false *) - select_overload gen e1.etype (Overloads.collect_overloads (fun t -> t) cl (field_name f)) cl.cl_params params, false - | FStatic(c,f) -> - (* workaround for issue #1743 *) - (* f,f.cf_type, false *) - select_overload gen e1.etype ((f.cf_type,f) :: List.map (fun f -> f.cf_type,f) f.cf_overloads) [] [], true - | _ -> - gen.gwarning WGenerator "Overloaded classfield typed as anonymous" ecall.epos; - (cf, actual_t, true), true - in - - if not (is_static || error) then match find_first_declared_field gen cl ~exact_field:{ cf with cf_type = actual_t } cf.cf_name with - | Some(cf_orig,actual_t,_,_,declared_cl,tl,tlch) -> - let rec is_super e = match e.eexpr with - | TConst TSuper -> true - | TParenthesis p | TMeta(_,p) -> is_super p - | _ -> false - in - if declared_cl != cl && overloads_cast_to_base && not (is_super !ef) then begin - let pos = (!ef).epos in - ef := { - eexpr = TCall( - { eexpr = TIdent "__as__"; etype = t_dynamic; epos = pos }, - [!ef]); - etype = TInst(declared_cl,List.map (apply_params cl.cl_params params) tl); - epos = pos - } - end; - { cf_orig with cf_name = cf.cf_name },actual_t,false - | None -> - gen.gwarning WGenerator "Cannot find matching overload" ecall.epos; - cf, actual_t, true - else - cf,actual_t,error - in - - (* take off Rest param *) - let _,actual_t = change_rest actual_t elist in - (* set the real (selected) class field *) - let f = match f with - | FInstance(c,tl,_) -> FInstance(c,tl,cf) - | FClosure(c,_) -> FClosure(c,cf) - | FStatic(c,_) -> FStatic(c,cf) - | f -> f - in - let error = error || (match follow actual_t with | TFun _ -> false | _ -> true) in - if error then (* if error, ignore arguments *) - if ExtType.is_void ecall.etype then - { ecall with eexpr = TCall({ e1 with eexpr = TField(!ef, f) }, elist ) } - else - local_mk_cast ecall.etype { ecall with eexpr = TCall({ e1 with eexpr = TField(!ef, f) }, elist ) } - else begin - (* infer arguments *) - (* let called_t = TFun(List.map (fun e -> "arg",false,e.etype) elist, ecall.etype) in *) - let called_t = match follow e1.etype with | TFun _ -> e1.etype | _ -> TFun(List.map (fun e -> "arg",false,e.etype) elist, ecall.etype) in (* workaround for issue #1742 *) - let expects_rest_args,called_t = change_rest called_t elist in - let original = (get_fun (apply_params cl.cl_params params actual_t)) in - let applied = (get_fun called_t) in - let fparams = infer_params ecall.epos original applied cf.cf_params calls_parameters_explicitly in - (* get what the backend actually sees *) - (* actual field's function *) - let actual_t = get_real_fun gen actual_t in - let real_params = gen.greal_type_param (TClassDecl cl) params in - let function_t = apply_params cl.cl_params real_params actual_t in - let real_fparams = if calls_parameters_explicitly then - gen.greal_type_param (TClassDecl cl) fparams - else - gen.greal_type_param (TClassDecl cl) (infer_params ecall.epos (get_fun function_t) (get_fun (get_real_fun gen called_t)) cf.cf_params calls_parameters_explicitly) in - let function_t = get_real_fun gen (apply_params cf.cf_params real_fparams function_t) in - let args_ft, ret_ft = get_fun function_t in - (* applied function *) - let applied = elist in - (* check types list *) - let new_ecall, elist = try - let fn = fun funct applied -> - match is_overload || real_fparams <> [], applied.eexpr with - | true, TConst TNull -> - mk_castfast (gen.greal_type funct) applied - | true, _ -> (* when not (type_iseq gen (gen.greal_type applied.etype) funct) -> *) - let ret = handle_cast gen applied (funct) (gen.greal_type applied.etype) in - (match ret.eexpr with - | TCast _ -> ret - | _ -> local_mk_cast (funct) ret) - | _ -> - handle_cast gen applied (funct) (gen.greal_type applied.etype) - in - let rec loop args_ft applied = - match args_ft, applied with - | [], [] -> [] - | [(_,_,funct)], _ when expects_rest_args -> - (match funct, applied with - | _,[{ eexpr = TUnop(Spread,Prefix,a) }] - | _,[{ eexpr = TParenthesis({ eexpr = TUnop(Spread,Prefix,a) }) }] -> - [fn funct a] - | TInst({ cl_path = (_,"NativeArray") },[funct]),_ -> - List.map (fn funct) applied - | _, a :: applied -> - (fn funct a) :: loop args_ft applied - | _, [] -> - [] - ) - | (_,_,funct)::args_ft, a::applied -> - (fn funct a) :: loop args_ft applied - | _ -> raise (Invalid_argument "Args length mismatch") - in - let elist = loop args_ft applied in - { ecall with - eexpr = TCall( - { e1 with eexpr = TField(!ef, f) }, - elist); - }, elist - with Invalid_argument _ -> - gen.gwarning WGenerator ("This expression may be invalid" ) ecall.epos; - { ecall with eexpr = TCall({ e1 with eexpr = TField(!ef, f) }, elist) }, elist - in - let new_ecall = if fparams <> [] then gen.gparam_func_call new_ecall { e1 with eexpr = TField(!ef, f) } fparams elist else new_ecall in - let ret = handle_cast gen new_ecall (gen.greal_type ecall.etype) (gen.greal_type ret_ft) in - (match gen.gcon.platform, cf.cf_params, ret.eexpr with - | _, _, TCast _ -> ret - | Java, _ :: _, _ -> - (* this is a workaround for a javac openjdk issue with unused type parameters and return type inference *) - (* see more at issue #3123 *) - mk_cast (gen.greal_type ret_ft) new_ecall - | _ -> ret) - end - | FClassField (cl,params,_,{ cf_kind = (Method MethDynamic | Var _) },_,actual_t,_) -> - (* if it's a var, we will just try to apply the class parameters that have been changed with greal_type_param *) - let t = apply_params cl.cl_params (gen.greal_type_param (TClassDecl cl) params) (gen.greal_type actual_t) in - return_var (handle_cast gen { e1 with eexpr = TField(ef, f) } (gen.greal_type e1.etype) (gen.greal_type t)) - | FClassField (cl,params,_,cf,_,actual_t,_) -> - return_var (handle_cast gen { e1 with eexpr = TField({ ef with etype = t_dynamic }, f) } e1.etype t_dynamic) (* force dynamic and cast back to needed type *) - | FEnumField (en, efield, true) -> - let ecall = match e with | None -> trace (field_name f); trace efield.ef_name; gen.gcon.error "This field should be called immediately" ef.epos; die "" __LOC__ | Some ecall -> ecall in - (match en.e_params with - (* - | [] -> - let args, ret = get_fun (efield.ef_type) in - let ef = { ef with eexpr = TTypeExpr( TEnumDecl en ); etype = TEnum(en, []) } in - handle_cast gen { ecall with eexpr = TCall({ e1 with eexpr = TField(ef, FEnum(en, efield)) }, List.map2 (fun param (_,_,t) -> handle_cast gen param (gen.greal_type t) (gen.greal_type param.etype)) elist args) } (gen.greal_type ecall.etype) (gen.greal_type ret) - *) - | _ -> - let pt = match e with | None -> real_type | Some _ -> snd (get_fun e1.etype) in - let _params = match follow pt with | TEnum(_, p) -> p | _ -> gen.gwarning WGenerator (debug_expr e1) e1.epos; die "" __LOC__ in - let args, ret = get_fun efield.ef_type in - let actual_t = TFun(List.map (fun (n,o,t) -> (n,o,gen.greal_type t)) args, gen.greal_type ret) in - (* - because of differences on how is handled on the platforms, this is a hack to be able to - correctly use class field type parameters with RealTypeParams - *) - let cf_params = List.map (fun t -> match follow t with | TDynamic _ -> t_empty | _ -> t) _params in - let t = apply_params en.e_params (gen.greal_type_param (TEnumDecl en) cf_params) actual_t in - let t = apply_params efield.ef_params (List.map (fun _ -> t_dynamic) efield.ef_params) t in - - let args, ret = get_fun t in - - let elist = List.map2 (fun param (_,_,t) -> handle_cast gen (param) (gen.greal_type t) (gen.greal_type param.etype)) elist args in - let e1 = { e1 with eexpr = TField({ ef with eexpr = TTypeExpr( TEnumDecl en ); etype = TEnum(en, _params) }, FEnum(en, efield) ) } in - let new_ecall = gen.gparam_func_call ecall e1 _params elist in - - handle_cast gen new_ecall (gen.greal_type ecall.etype) (gen.greal_type ret) - ) - | FEnumField _ when is_some e -> die "" __LOC__ - | FEnumField (en,efield,_) -> - return_var { e1 with eexpr = TField({ ef with eexpr = TTypeExpr( TEnumDecl en ); },FEnum(en,efield)) } - (* no target by date will uses this.so this code may not be correct at all *) - | FAnonField cf -> - let t = gen.greal_type cf.cf_type in - return_var (handle_cast gen { e1 with eexpr = TField(ef, f) } (gen.greal_type e1.etype) t) - | FNotFound - | FDynamicField _ -> - if is_some e then - return_var { e1 with eexpr = TField(ef, f) } - else - return_var (handle_cast gen { e1 with eexpr = TField({ ef with etype = t_dynamic }, f) } e1.etype t_dynamic) (* force dynamic and cast back to needed type *) - ) - -(* end of type parameter handling *) -(* ****************************** *) - -(** overloads_cast_to_base argument will cast overloaded function types to the class that declared it. **) -(** This is necessary for C#, and if true, will require the target to implement __as__, as a `quicker` form of casting **) -let configure gen ?(overloads_cast_to_base = false) maybe_empty_t calls_parameters_explicitly = - let handle e t1 t2 = handle_cast gen e (gen.greal_type t1) (gen.greal_type t2) in - - let in_value = ref false in - - let rec clean_cast e = match e.eexpr with - | TCast(e,_) -> clean_cast e - | TParenthesis(e) | TMeta(_,e) -> clean_cast e - | _ -> e - in - - let get_abstract_impl t = match t with - | TAbstract(a,pl) when not (Meta.has Meta.CoreType a.a_meta) -> - Abstract.get_underlying_type a pl - | t -> t - in - - let rec is_abstract_to_struct t = match t with - | TAbstract(a,pl) when not (Meta.has Meta.CoreType a.a_meta) -> - is_abstract_to_struct (Abstract.get_underlying_type a pl) - | TInst(c,_) when Meta.has Meta.Struct c.cl_meta -> - true - | _ -> false - in - - let binop_type fast_cast op main_expr e1 e2 = - let name = platform_name gen.gcon.platform in - let basic = gen.gcon.basic in - (* If either operand is of type decimal, the other operand is converted to type decimal, or a compile-time error occurs if the other operand is of type float or double. - * Otherwise, if either operand is of type double, the other operand is converted to type double. - * Otherwise, if either operand is of type float, the other operand is converted to type float. - * Otherwise, if either operand is of type ulong, the other operand is converted to type ulong, or a compile-time error occurs if the other operand is of type sbyte, short, int, or long. - * Otherwise, if either operand is of type long, the other operand is converted to type long. - * Otherwise, if either operand is of type uint and the other operand is of type sbyte, short, or int, both operands are converted to type long. - * Otherwise, if either operand is of type uint, the other operand is converted to type uint. - * Otherwise, both operands are converted to type int. - * *) - let t1, t2 = follow (run_follow gen e1.etype), follow (run_follow gen e2.etype) in - let result = - match t1, t2 with - | TAbstract(a1,[]), TAbstract(a2,[]) when fast_cast && a1 == a2 -> - { main_expr with eexpr = TBinop(op, e1, e2); etype = e1.etype } - | TInst(i1,[]), TInst(i2,[]) when fast_cast && i1 == i2 -> - { main_expr with eexpr = TBinop(op, e1, e2); etype = e1.etype } - | TInst({ cl_path = ([],"String") },[]), _ when fast_cast && op = OpAdd -> - { main_expr with eexpr = TBinop(op, e1, mk_cast basic.tstring e2); etype = basic.tstring } - | _, TInst({ cl_path = ([],"String") },[]) when fast_cast && op = OpAdd -> - { main_expr with eexpr = TBinop(op, mk_cast basic.tstring e1, e2); etype = basic.tstring } - | TAbstract({ a_path = ([], "Float") }, []), _ when fast_cast -> - { main_expr with eexpr = TBinop(op, e1, e2); etype = e1.etype } - | _, TAbstract({ a_path = ([], "Float") }, []) when fast_cast -> - { main_expr with eexpr = TBinop(op, e1, e2); etype = e2.etype } - | TAbstract({ a_path = ([], "Single") }, []), _ when fast_cast -> - { main_expr with eexpr = TBinop(op, e1, e2); etype = e1.etype } - | _, TAbstract({ a_path = ([], "Single") }, []) when fast_cast -> - { main_expr with eexpr = TBinop(op, e1, e2); etype = e2.etype } - | TAbstract({ a_path = ([pf], "UInt64") }, []), _ when fast_cast && pf = name -> - { main_expr with eexpr = TBinop(op, e1, e2); etype = e1.etype } - | _, TAbstract({ a_path = ([pf], "UInt64") }, []) when fast_cast && pf = name -> - { main_expr with eexpr = TBinop(op, e1, e2); etype = e2.etype } - | TAbstract({ a_path = ([pf], "Int64") }, []), _ when fast_cast && pf = name -> - { main_expr with eexpr = TBinop(op, e1, e2); etype = e1.etype } - | _, TAbstract({ a_path = ([pf], "Int64") }, []) when fast_cast && pf = name -> - { main_expr with eexpr = TBinop(op, e1, e2); etype = e2.etype } - | TAbstract({ a_path = ([], "UInt") }, []), tother when like_int tother -> - let ti64 = mt_to_t_dyn ( get_type gen ([name], "Int64") ) in - let ret = { main_expr with eexpr = TBinop(op, e1, e2); etype = ti64 } in - if op <> OpDiv then - mk_cast t1 ret - else - ret - | tother, TAbstract({ a_path = ([], "UInt") }, []) when like_int tother -> - let ti64 = mt_to_t_dyn ( get_type gen ([name], "Int64") ) in - let ret = { main_expr with eexpr = TBinop(op, e1, e2); etype = ti64 } in - if op <> OpDiv then - mk_cast t2 ret - else - ret - | TAbstract({ a_path = ([], "UInt") }, []), _ -> - { main_expr with eexpr = TBinop(op, e1, e2); etype = e1.etype } - | _, TAbstract({ a_path = ([], "UInt") }, []) -> - { main_expr with eexpr = TBinop(op, e1, e2); etype = e2.etype } - | TAbstract(a1,[]), TAbstract(a2,[]) when fast_cast -> - { main_expr with eexpr = TBinop(op, e1, e2); etype = basic.tint } - | _ -> - { main_expr with eexpr = TBinop(op, e1, e2) } - in - (* maintain nullability *) - match follow_without_null main_expr.etype, follow_without_null result.etype with - | TAbstract ({ a_path = ([],"Null") },_), TAbstract ({ a_path = ([],"Null") },_) -> - result - | TAbstract ({ a_path = ([],"Null") } as null,_), _ -> - { result with etype = TAbstract(null, [result.etype]) } - | _, TAbstract ({ a_path = ([],"Null") },[t]) -> - { result with etype = t } - | _ -> result - in - let binop_type = binop_type (Common.defined gen.gcon Define.FastCast) in - - let rec run ?(just_type = false) e = - let handle = if not just_type then handle else fun e t1 t2 -> { e with etype = gen.greal_type t2 } in - let was_in_value = !in_value in - in_value := true; - match e.eexpr with - | TConst ( TInt _ | TFloat _ | TBool _ as const ) -> - (* take off any Null<> that it may have *) - let t = follow (run_follow gen e.etype) in - (* do not allow constants typed as Single - need to cast them *) - let real_t = match const with - | TInt _ -> gen.gcon.basic.tint - | TFloat _ -> gen.gcon.basic.tfloat - | TBool _ -> gen.gcon.basic.tbool - | _ -> die "" __LOC__ - in - handle e t real_t - | TCast( { eexpr = TConst TNull }, _ ) -> - { e with eexpr = TConst TNull } - | TCast( { eexpr = TCall( { eexpr = TIdent "__delegate__" } as local, [del] ) } as e2, _) -> - { e with eexpr = TCast({ e2 with eexpr = TCall(local, [Type.map_expr run del]) }, None) } - - | TBinop (OpAssignOp (Ast.OpShl | Ast.OpShr | Ast.OpUShr as op), e1, e2 ) -> - let e1 = run ~just_type:true e1 in - let e2 = handle (run e2) (gen.gcon.basic.tint) e2.etype in - let rett = binop_type op e e1 e2 in - { e with eexpr = TBinop(OpAssignOp op, e1, e2); etype = rett.etype } - | TBinop ( (Ast.OpAssign | Ast.OpAssignOp _ as op), e1, e2 ) -> - let e1 = run ~just_type:true e1 in - let e2 = handle (run e2) e1.etype e2.etype in - { e with eexpr = TBinop(op, clean_cast e1, e2) } - | TBinop ( (Ast.OpShl | Ast.OpShr | Ast.OpUShr as op), e1, e2 ) -> - let e1 = run e1 in - let e2 = handle (run e2) (gen.gcon.basic.tint) e2.etype in - let rett = binop_type op e e1 e2 in - { e with eexpr = TBinop(op, e1, e2); etype = rett.etype } - | TBinop( (OpAdd | OpMult | OpDiv | OpSub | OpAnd | OpOr | OpXor | OpMod) as op, e1, e2 ) -> - binop_type op e (run e1) (run e2) - | TBinop( (OpEq | OpNotEq | OpGt | OpGte | OpLt | OpLte | OpBoolAnd | OpBoolOr) as op, e1, e2 ) -> - handle { e with eexpr = TBinop(op, run e1, run e2) } e.etype gen.gcon.basic.tbool - | TField(ef, f) -> - handle_type_parameter gen None e (run ef) ~clean_ef:ef ~overloads_cast_to_base:overloads_cast_to_base f [] calls_parameters_explicitly - | TArrayDecl el -> - let et = e.etype in - let base_type = match follow et with - | TInst({ cl_path = ([], "Array") } as cl, bt) -> gen.greal_type_param (TClassDecl cl) bt - | _ -> - gen.gwarning WGenerator (debug_type et) e.epos; - (match gen.gcurrent_class with - | Some cl -> print_endline (s_type_path cl.cl_path) - | _ -> ()); - die "" __LOC__ - in - let base_type = List.hd base_type in - { e with eexpr = TArrayDecl( List.map (fun e -> handle (run e) base_type e.etype) el ); etype = et } - | TCall ({ eexpr = TIdent "__array__" } as arr_local, el) -> - let et = e.etype in - let base_type = match follow et with - | TInst(cl, bt) -> gen.greal_type_param (TClassDecl cl) bt - | _ -> die "" __LOC__ - in - let base_type = List.hd base_type in - { e with eexpr = TCall(arr_local, List.map (fun e -> handle (run e) base_type e.etype) el ); etype = et } - | TCall( ({ eexpr = TIdent s } as local), params ) when String.get s 0 = '_' && String.get s 1 = '_' && Hashtbl.mem gen.gspecial_vars s -> - { e with eexpr = TCall(local, List.map (fun e -> (match e.eexpr with TBlock _ -> in_value := false | _ -> ()); run e) params) } - | TCall( ({ eexpr = TField(ef, f) }) as e1, elist ) -> - handle_type_parameter gen (Some e) (e1) (run ef) ~clean_ef:ef ~overloads_cast_to_base:overloads_cast_to_base f (List.map run elist) calls_parameters_explicitly - - | TCall( { eexpr = TConst TSuper } as ef, eparams ) -> - let cl, tparams = match follow ef.etype with - | TInst(cl,p) -> - cl,p - | _ -> die "" __LOC__ in - (try - let is_overload, cf, sup, stl = choose_ctor gen cl tparams (List.map (fun e -> e.etype) eparams) maybe_empty_t e.epos in - let handle e t1 t2 = - if is_overload then - let ret = handle e t1 t2 in - match ret.eexpr with - | TCast _ -> ret - | _ -> mk_cast (gen.greal_type t1) e - else - handle e t1 t2 - in - let stl = gen.greal_type_param (TClassDecl sup) stl in - let args,rt = get_fun (apply_params sup.cl_params stl cf.cf_type) in - let eparams = List.map2 (fun e (_,_,t) -> - handle (run e) t e.etype - ) (wrap_rest_args gen (TFun (args,rt)) eparams e.epos) args in - { e with eexpr = TCall(ef, eparams) } - with | Not_found -> - gen.gwarning WGenerator "No overload found for this constructor call" e.epos; - { e with eexpr = TCall(ef, List.map run eparams) }) - | TCall (ef, eparams) -> - (match ef.etype with - | TFun(p, ret) -> - handle ({ e with eexpr = TCall(run ef, List.map2 (fun param (_,_,t) -> handle (run param) t param.etype) eparams p) }) e.etype ret - | _ -> Type.map_expr run e - ) - | TNew ({ cl_kind = KTypeParameter _ }, _, _) -> - Type.map_expr run e - | TNew (cl, tparams, eparams) -> (try - let is_overload, cf, sup, stl = choose_ctor gen cl tparams (List.map (fun e -> e.etype) eparams) maybe_empty_t e.epos in - let handle e t1 t2 = - if is_overload then - let ret = handle e t1 t2 in - match ret.eexpr with - | TCast _ -> ret - | _ -> mk_cast (gen.greal_type t1) e - else - handle e t1 t2 - in - let stl = gen.greal_type_param (TClassDecl sup) stl in - let args,rt = get_fun (apply_params sup.cl_params stl cf.cf_type) in - let eparams = List.map2 (fun e (_,_,t) -> - handle (run e) t e.etype - ) (wrap_rest_args gen (TFun (args,rt)) eparams e.epos) args in - { e with eexpr = TNew(cl, tparams, eparams) } - with | Not_found -> - gen.gwarning WGenerator "No overload found for this constructor call" e.epos; - { e with eexpr = TNew(cl, tparams, List.map run eparams) }) - | TUnop((Increment | Decrement) as op, flag, ({ eexpr = TArray (arr, idx) } as e2)) - when (match follow arr.etype with TInst({ cl_path = ["cs"],"NativeArray" },_) -> true | _ -> false) -> - { e with eexpr = TUnop(op, flag, { e2 with eexpr = TArray(run arr, idx) })} - | TArray(arr, idx) -> - let arr_etype = match follow arr.etype with - | (TInst _ as t) -> t - | TAbstract (a, pl) when not (Meta.has Meta.CoreType a.a_meta) -> - follow (Abstract.get_underlying_type a pl) - | t -> t - in - let idx = run idx in - let idx = match gen.greal_type idx.etype with - | TAbstract({ a_path = [],"Int" },_) -> idx - | _ -> match handle idx gen.gcon.basic.tint (gen.greal_type idx.etype) with - | ({ eexpr = TCast _ } as idx) -> idx - | idx -> mk_cast gen.gcon.basic.tint idx - in - let e = { e with eexpr = TArray(run arr, idx) } in - (* get underlying class (if it's a class *) - (match arr_etype with - | TInst({ cl_path = ["cs"],"NativeArray" }, _) when - (match Abstract.follow_with_abstracts e.etype with TInst _ | TEnum _ -> true | _ -> false) - || Common.defined gen.gcon Define.EraseGenerics - -> - mk_cast e.etype e - | TInst(cl, params) -> - (* see if it implements ArrayAccess *) - (match cl.cl_array_access with - | None -> e - | Some t -> - (* if it does, apply current parameters (and change them) *) - (* let real_t = apply_params_internal (List.map (gen.greal_type_param (TClassDecl cl))) cl params t in *) - let param = apply_params cl.cl_params (gen.greal_type_param (TClassDecl cl) params) t in - let real_t = apply_params cl.cl_params params param in - (* see if it needs a cast *) - - fastcast_if_needed gen e (gen.greal_type e.etype) (gen.greal_type real_t) - (* handle (e) (gen.greal_type e.etype) (gen.greal_type real_t) *) - ) - | _ -> Type.map_expr run e) - | TVar (v, eopt) -> - { e with eexpr = TVar (v, match eopt with - | None -> eopt - | Some e -> Some( handle (run e) v.v_type e.etype )) - } - (* FIXME deal with in_value when using other statements that may not have a TBlock wrapped on them *) - | TIf (econd, ethen, Some(eelse)) when was_in_value -> - { e with eexpr = TIf (handle (run econd) gen.gcon.basic.tbool econd.etype, handle (run ethen) e.etype ethen.etype, Some( handle (run eelse) e.etype eelse.etype ) ) } - | TIf (econd, ethen, eelse) -> - { e with eexpr = TIf (handle (run econd) gen.gcon.basic.tbool econd.etype, (in_value := false; run (mk_block ethen)), Option.map (fun e -> in_value := false; run (mk_block e)) eelse) } - | TWhile (econd, e1, flag) -> - { e with eexpr = TWhile (handle (run econd) gen.gcon.basic.tbool econd.etype, (in_value := false; run (mk_block e1)), flag) } - | TSwitch switch -> - let switch = { switch with - switch_subject = run switch.switch_subject; - switch_cases = List.map (fun case -> { - case_patterns = List.map run case.case_patterns; - case_expr = (in_value := false; run (mk_block case.case_expr)) - }) switch.switch_cases; - switch_default = Option.map (fun e -> in_value := false; run (mk_block e)) switch.switch_default; - } in - { e with eexpr = TSwitch switch } - | TFor (v,cond,e1) -> - { e with eexpr = TFor(v, run cond, (in_value := false; run (mk_block e1))) } - | TTry (e, ve_l) -> - { e with eexpr = TTry((in_value := false; run (mk_block e)), List.map (fun (v,e) -> in_value := false; (v, run (mk_block e))) ve_l) } - | TBlock el -> - let i = ref 0 in - let len = List.length el in - { e with eexpr = TBlock ( List.map (fun e -> - incr i; - if !i <> len || not was_in_value then - in_value := false; - run e - ) el ) } - | TCast (expr, md) when ExtType.is_void (follow e.etype) -> - run expr - | TCast (expr, md) -> - let rec get_null e = - match e.eexpr with - | TConst TNull -> Some e - | TParenthesis e | TMeta(_,e) -> get_null e - | _ -> None - in - - (match get_null expr with - | Some enull -> - if gen.gcon.platform = Cs then - { enull with etype = gen.greal_type e.etype } - else - mk_cast (gen.greal_type e.etype) enull - | _ when is_abstract_to_struct expr.etype && type_iseq gen e.etype (get_abstract_impl expr.etype) -> - run { expr with etype = expr.etype } - | _ when is_exactly_basic gen expr.etype e.etype -> - run { expr with etype = expr.etype } - | _ -> - match gen.greal_type e.etype, gen.greal_type expr.etype with - | (TInst(c,tl) as tinst1), TAbstract({ a_path = ["cs"],"Pointer" }, [tinst2]) when type_iseq gen tinst1 (gen.greal_type tinst2) -> - run expr - | _ -> - let expr = run expr in - let last_unsafe = gen.gon_unsafe_cast in - gen.gon_unsafe_cast <- (fun t t2 pos -> ()); - let ret = handle expr e.etype expr.etype in - gen.gon_unsafe_cast <- last_unsafe; - match ret.eexpr with - | TCast _ -> { ret with etype = gen.greal_type e.etype } - | _ -> { e with eexpr = TCast(ret,md); etype = gen.greal_type e.etype } - ) - (*| TCast _ -> - (* if there is already a cast, we should skip this cast check *) - Type.map_expr run e*) - | TFunction f -> - in_value := false; - Type.map_expr run e - - | _ -> Type.map_expr run e - in - gen.ghandle_cast <- (fun tto tfrom expr -> handle_cast gen expr (gen.greal_type tto) (gen.greal_type tfrom)); - let map e = - match gen.gcurrent_classfield with - | Some cf when Meta.has (Meta.Custom ":skipCastDetect") cf.cf_meta -> - e - | _ -> - run e - in - gen.gsyntax_filters#add name (PCustom priority) map; - ReturnCast.configure gen diff --git a/src/codegen/gencommon/classInstance.ml b/src/codegen/gencommon/classInstance.ml deleted file mode 100644 index f35e38f1ea9..00000000000 --- a/src/codegen/gencommon/classInstance.ml +++ /dev/null @@ -1,57 +0,0 @@ -(* - The Haxe Compiler - Copyright (C) 2005-2019 Haxe Foundation - - This program is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License - as published by the Free Software Foundation; either version 2 - of the License, or (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. -*) -open Type -open Gencommon - -(* - When we pass a class as an object, in some languages we will need a special construct to be able to - access its statics as if they were normal object fields. On C# and Java the way found to do that is - by handling statics reflection also by a normal instance. This also happens in hxcpp and neko, so I - guess it's a valid practice. - - So if we want to handle the reflection of the static MyClass, here's roughly how it will be done: - - var x = MyClass; - gets converted into - var x = typeof(MyClass); -*) -let add_typeof = - let rec run e = - match e.eexpr with - | TCall (({ eexpr = TIdent ("__is__" | "__as__" | "__typeof__") } as elocal), args) -> - let args = List.map (fun e -> match e.eexpr with TTypeExpr _ -> e | _ -> run e) args in - { e with eexpr = TCall (elocal, args) } - | TField ({ eexpr = TTypeExpr _ }, _) -> - e - | TField (ef, f) -> - (match anon_class ef.etype with - | None -> Type.map_expr run e - | Some t -> { e with eexpr = TField ({ ef with eexpr = TTypeExpr t }, f)}) - | TTypeExpr _ -> - { e with eexpr = TCall (mk (TIdent "__typeof__") t_dynamic e.epos, [e]) } - | _ -> - Type.map_expr run e - in - run - -let name = "class_instance" -let priority = solve_deps name [] - -let configure gen = - gen.gsyntax_filters#add name (PCustom priority) add_typeof diff --git a/src/codegen/gencommon/closuresToClass.ml b/src/codegen/gencommon/closuresToClass.ml deleted file mode 100644 index f79951d01c1..00000000000 --- a/src/codegen/gencommon/closuresToClass.ml +++ /dev/null @@ -1,1181 +0,0 @@ -(* - The Haxe Compiler - Copyright (C) 2005-2019 Haxe Foundation - - This program is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License - as published by the Free Software Foundation; either version 2 - of the License, or (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. -*) -open Option -open Common -open Globals -open Texpr.Builder -open Ast -open Type -open Gencommon - -(* ******************************************* *) -(* Closures To Class *) -(* ******************************************* *) -(* - - This is a very important filter. It will take all anonymous functions from the AST, will search for all captured variables, and will create a class - that implements an abstract interface for calling functions. This is very important for targets that don't support anonymous functions to work correctly. - Also it is possible to implement some strategies to avoid value type boxing, such as NaN tagging or double/object arguments. All this will be abstracted away - from this interface. - - - dependencies: - must run after dynamic field access, because of conflicting ways to deal with invokeField - (module filter) must run after OverloadingConstructor so we can also change the dynamic function expressions - - uses TArray expressions for array. TODO see interaction - uses TThrow expressions. -*) -let name = "closures_to_class" -let priority = solve_deps name [ DAfter DynamicFieldAccess.priority ] - -type closures_ctx = { - func_class : tclass; - - (* - this is what will actually turn the function into class field. - The standard implementation by default will already take care of creating the class, and setting the captured variables. - - It will also return the super arguments to be called - *) - closure_to_classfield : tfunc->t->pos->tclass_field * (texpr list); - - (* - when a dynamic function call is made, we need to convert it as if it were calling the dynamic function interface. - - TCall expr -> new TCall expr - *) - dynamic_fun_call : texpr->texpr; - - (* - Provide a toolchain so we can easily create classes that extend Function and add more functionality on top of it. - - arguments: - tclass -> subject (so we know the type of this) - ( int -> (int->t->tconstant option->texpr) -> ( (tvar * tconstant option) list * texpr) ) - int -> current arity of the function whose member will be mapped; -1 for dynamic function. It is guaranteed that dynamic function will be called last - t -> the return type of the function - (int->t->tconstant option->texpr) -> api to get exprs that unwrap arguments correctly - int -> argument wanted to unwrap - t -> solicited type - tconstant option -> map to this default value if null - returns a texpr that tells how the default - should return a list with additional arguments (only works if is_function_base = true) - and the underlying function expression - *) - map_base_classfields : tclass->( int -> t -> (tvar list) -> (int->t->tconstant option->texpr) -> texpr )->tclass_field list; -} - -type map_info = { - in_unsafe : bool; - in_unused : bool; -} - -let null_map_info = { in_unsafe = false; in_unused = false; } - -(* - the default implementation will take 3 transformation functions: - * one that will transform closures that are not called immediately (instance.myFunc). - normally on this case it's best to have a runtime handler that will take the instance, the function and call its invokeField when invoked - * one that will actually handle the anonymous functions themselves. - * one that will transform calling a dynamic function. So for example, dynFunc(arg1, arg2) might turn into dynFunc.apply2(arg1, arg2); - ( suspended ) * an option to match papplied functions - * handling parameterized anonymous function declaration (optional - tparam_anon_decl and tparam_anon_acc) -*) - -let rec cleanup_delegate e = match e.eexpr with - | TParenthesis e | TMeta(_,e) - | TCast(e,_) -> cleanup_delegate e - | _ -> e - -let funct gen t = match follow (run_follow gen t) with - | TFun(args,ret) -> args,ret - | _ -> raise Not_found - -let mk_conversion_fun gen e = - let args, ret = funct gen e.etype in - let i = ref 0 in - let tf_args = List.map (fun (n,o,t) -> - let n = if n = "" then ("arg" ^ string_of_int(!i)) else n in - incr i; - alloc_var n t,None) args - in - let block, local = match e.eexpr with - | TLocal v -> - add_var_flag v VCaptured; - [],e - | _ -> - let tmp = mk_temp "delegate_conv" e.etype in - add_var_flag tmp VCaptured; - [{ eexpr = TVar(tmp,Some e); etype = gen.gcon.basic.tvoid; epos = e.epos }], mk_local tmp e.epos - in - let body = { - eexpr = TCall(local, List.map (fun (v,_) -> mk_local v e.epos) tf_args); - etype = ret; - epos = e.epos; - } in - let body = if not (ExtType.is_void ret) then - mk_return body - else - body - in - let body = { - eexpr = TBlock([body]); - etype = body.etype; - epos = body.epos; - } in - block, { - tf_args = tf_args; - tf_expr = body; - tf_type = ret; - } - -let traverse gen ?tparam_anon_decl ?tparam_anon_acc (handle_anon_func:texpr->tfunc->map_info->t option->texpr) (dynamic_func_call:texpr->texpr) e = - let info = ref null_map_info in - let rec run e = - match e.eexpr with - | TCast({ eexpr = TCall({ eexpr = TIdent "__delegate__" } as local, [del] ) } as e2, _) -> - let e2 = { e2 with etype = e.etype } in - let replace_delegate ex = - { e with eexpr = TCast({ e2 with eexpr = TCall(local, [ex]) }, None) } - in - (* found a delegate; let's see if it's a closure or not *) - let clean = cleanup_delegate del in - (match clean.eexpr with - | TField( ef, (FClosure _ as f)) | TField( ef, (FStatic _ as f)) -> - (* a closure; let's leave this unchanged for FilterClosures to handle it *) - replace_delegate { clean with eexpr = TField( run ef, f ) } - | TFunction tf -> - (* handle like we'd handle a normal function, but create an unchanged closure field for it *) - let ret = handle_anon_func clean { tf with tf_expr = run tf.tf_expr } !info (Some e.etype) in - replace_delegate ret - | _ -> try - let block, tf = mk_conversion_fun gen del in - let block = List.map run block in - let tf = { tf with tf_expr = run tf.tf_expr } in - let ret = handle_anon_func { clean with eexpr = TFunction(tf) } { tf with tf_expr = run tf.tf_expr } !info (Some e.etype) in - let ret = replace_delegate ret in - if block = [] then - ret - else - { ret with eexpr = TBlock(block @ [ret]) } - with Not_found -> - gen.gcon.error "This delegate construct is unsupported" e.epos; - replace_delegate (run clean)) - - | TCall(({ eexpr = TIdent "__unsafe__" } as local), [arg]) -> - let old = !info in - info := { !info with in_unsafe = true }; - let arg2 = run arg in - info := old; - { e with eexpr = TCall(local,[arg2]) } - (* parameterized functions handling *) - | TVar(vv, ve) -> (match tparam_anon_decl with - | None -> Type.map_expr run e - | Some tparam_anon_decl -> - (match (vv, ve) with - | ({ v_extra = Some({v_params = _ :: _}) } as v), Some ({ eexpr = TFunction tf } as f) - | ({ v_extra = Some({v_params = _ :: _}) } as v), Some { eexpr = TArrayDecl([{ eexpr = TFunction tf } as f]) | TCall({ eexpr = TIdent "__array__" }, [{ eexpr = TFunction tf } as f]) } -> (* captured transformation *) - tparam_anon_decl v f { tf with tf_expr = run tf.tf_expr }; - { e with eexpr = TBlock([]) } - | _ -> - Type.map_expr run { e with eexpr = TVar(vv, ve) }) - ) - | TBinop(OpAssign, { eexpr = TLocal({ v_extra = Some({v_params = _ :: _}) } as v)}, ({ eexpr= TFunction tf } as f)) when is_some tparam_anon_decl -> - (match tparam_anon_decl with - | None -> die "" __LOC__ - | Some tparam_anon_decl -> - tparam_anon_decl v f { tf with tf_expr = run tf.tf_expr }; - { e with eexpr = TBlock([]) } - ) - | TLocal ({ v_extra = Some({v_params = _ :: _}) } as v) -> - (match tparam_anon_acc with - | None -> Type.map_expr run e - | Some tparam_anon_acc -> tparam_anon_acc v e false) - | TArray ( ({ eexpr = TLocal ({ v_extra = Some({v_params = _ :: _}) } as v) } as expr), _) -> (* captured transformation *) - (match tparam_anon_acc with - | None -> Type.map_expr run e - | Some tparam_anon_acc -> tparam_anon_acc v { expr with etype = e.etype } false) - | TMeta((Meta.Custom ":tparamcall",_,_),({ eexpr=TLocal ({ v_extra = Some({v_params = _ :: _}) } as v) } as expr)) -> - (match tparam_anon_acc with - | None -> Type.map_expr run e - | Some tparam_anon_acc -> tparam_anon_acc v expr true) - | TCall( { eexpr = TField(_, FEnum _) }, _ ) -> - Type.map_expr run e - (* if a TClosure is being call immediately, there's no need to convert it to a TClosure *) - | TCall(( { eexpr = TField(ecl,f) } as e1), params) -> - (* check to see if called field is known and if it is a MethNormal (only MethNormal fields can be called directly) *) - (* let name = field_name f in *) - (match field_access_esp gen (gen.greal_type ecl.etype) f with - | FClassField(_,_,_,cf,_,_,_) -> - (match cf.cf_kind with - | Method MethNormal - | Method MethInline -> - { e with eexpr = TCall({ e1 with eexpr = TField(run ecl, f) }, List.map run params) } - | _ -> - match gen.gfollow#run_f e1.etype with - | TFun _ -> - dynamic_func_call { e with eexpr = TCall(run e1, List.map run params) } - | _ -> - let i = ref 0 in - let t = TFun(List.map (fun e -> incr i; "arg" ^ (string_of_int !i), false, e.etype) params, e.etype) in - dynamic_func_call { e with eexpr = TCall( mk_castfast t (run e1), List.map run params ) } - ) - (* | FNotFound -> - { e with eexpr = TCall({ e1 with eexpr = TField(run ecl, f) }, List.map run params) } - (* expressions by now may have generated invalid expressions *) *) - | _ -> - match gen.gfollow#run_f e1.etype with - | TFun _ -> - dynamic_func_call { e with eexpr = TCall(run e1, List.map run params) } - | _ -> - let i = ref 0 in - let t = TFun(List.map (fun e -> incr i; "arg" ^ (string_of_int !i), false, e.etype) params, e.etype) in - dynamic_func_call { e with eexpr = TCall( mk_castfast t (run e1), List.map run params ) } - ) - | TFunction tf -> - handle_anon_func e { tf with tf_expr = run tf.tf_expr } !info None - | TCall({ eexpr = TConst(TSuper) }, _) -> - Type.map_expr run e - | TCall({ eexpr = TIdent s }, args) when String.get s 0 = '_' && Hashtbl.mem gen.gspecial_vars s -> - Type.map_expr run e - | TCall(tc,params) -> - let i = ref 0 in - let may_cast = match gen.gfollow#run_f tc.etype with - | TFun _ -> fun e -> e - | _ -> - let t = TFun(List.map (fun e -> - incr i; - ("p" ^ (string_of_int !i), false, e.etype) - ) params, e.etype) - in - fun e -> mk_castfast t e - in - dynamic_func_call { e with eexpr = TCall(run (may_cast tc), List.map run params) } - | _ -> Type.map_expr run e - in - - (match e.eexpr with - | TFunction(tf) -> Type.map_expr run e - | _ -> run e) - -let rec get_type_params acc t = - match t with - | TInst(( { cl_kind = KTypeParameter _ } as cl), []) -> - if List.memq cl acc then acc else cl :: acc - | TFun (params,tret) -> - List.fold_left get_type_params acc ( tret :: List.map (fun (_,_,t) -> t) params ) - | TDynamic None -> - acc - | TDynamic (Some t) -> - get_type_params acc t - | TAbstract (a, pl) when not (Meta.has Meta.CoreType a.a_meta) -> - get_type_params acc ( Abstract.get_underlying_type a pl) - | TAnon a -> - PMap.fold (fun cf acc -> - let params = List.map (fun tp -> tp.ttp_class) cf.cf_params in - List.filter (fun t -> not (List.memq t params)) (get_type_params acc cf.cf_type) - ) a.a_fields acc - | TType(_, []) - | TAbstract (_, []) - | TInst(_, []) - | TEnum(_, []) -> - acc - | TType(_, params) - | TAbstract(_, params) - | TEnum(_, params) - | TInst(_, params) -> - List.fold_left get_type_params acc params - | TMono r -> (match r.tm_type with - | Some t -> get_type_params acc t - | None -> acc) - | _ -> get_type_params acc (follow_once t) - -let get_captured expr = - let ret = Hashtbl.create 1 in - let ignored = Hashtbl.create 0 in - - let params = ref [] in - let check_params t = params := get_type_params !params t in - let rec traverse expr = - match expr.eexpr with - | TFor (v, _, _) -> - Hashtbl.add ignored v.v_id v; - check_params v.v_type; - Type.iter traverse expr - | TFunction(tf) -> - List.iter (fun (v,_) -> Hashtbl.add ignored v.v_id v) tf.tf_args; - (match follow expr.etype with - | TFun(args,ret) -> - List.iter (fun (_,_,t) -> - check_params t - ) args; - check_params ret - | _ -> ()); - Type.iter traverse expr - | TVar (v, opt) -> - (match v.v_extra with - | Some({v_params = _ :: _}) -> () - | _ -> - check_params v.v_type); - Hashtbl.add ignored v.v_id v; - ignore(Option.map traverse opt) - | TLocal { v_extra = Some({v_params = (_ :: _ )}) } -> - () - | TLocal v when has_var_flag v VCaptured -> - (if not (Hashtbl.mem ignored v.v_id || Hashtbl.mem ret v.v_id) then begin check_params v.v_type; Hashtbl.replace ret v.v_id expr end); - | _ -> Type.iter traverse expr - in traverse expr; - ret, !params - -(* - OPTIMIZEME: - - Take off from Codegen the code that wraps captured variables, - - traverse through all variables, looking for their use (just like local_usage) - three possible outcomes for captured variables: - - become a function member variable <- best performance. - Will not work on functions that can be created more than once (functions inside a loop or functions inside functions) - The function will have to be created on top of the block, so its variables can be filled in instead of being declared - - single-element array - the most compatible way, though also creates a slight overhead. - - we'll have some labels for captured variables: - - used in loop -*) - -(* - The default implementation will impose a naming convention: - invoke(arity)_(o for returning object/d for returning double) when arity < max_arity - invoke_dynamic_(o/d) when arity > max_arity - - This means that it also imposes that the dynamic function return types may only be Dynamic or Float, and all other basic types must be converted to/from it. -*) -let configure gen ft = - - let tvar_to_cdecl = Hashtbl.create 0 in - - let handle_anon_func fexpr ?tvar tfunc mapinfo delegate_type : texpr * (tclass * texpr list) = - let fexpr = match fexpr.eexpr with - | TFunction(_) -> - { fexpr with eexpr = TFunction(tfunc) } - | _ -> - gen.gcon.error "Function expected" fexpr.epos; - fexpr - in - let in_unsafe = mapinfo.in_unsafe || match gen.gcurrent_class, gen.gcurrent_classfield with - | Some c, _ when Meta.has Meta.Unsafe c.cl_meta -> true - | _, Some cf when Meta.has Meta.Unsafe cf.cf_meta -> true - | _ -> false - in - (* get all captured variables it uses *) - let captured_ht, tparams = get_captured fexpr in - let captured = Hashtbl.fold (fun _ e acc -> e :: acc) captured_ht [] in - let captured = List.sort (fun e1 e2 -> match e1, e2 with - | { eexpr = TLocal v1 }, { eexpr = TLocal v2 } -> - compare v1.v_name v2.v_name - | _ -> die "" __LOC__) captured - in - - (*let cltypes = List.map (fun cl -> (snd cl.cl_path, TInst(map_param cl, []) )) 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 - | None -> "Anon" - | Some cf -> cf.cf_name - in - let cur_line = Lexer.get_error_line fexpr.epos in - let name = match tvar with - | None -> - Printf.sprintf "%s_%s_%d__Fun" (snd gen.gcurrent_path) cfield cur_line - | Some (v) -> - Printf.sprintf "%s_%s_%d__Fun" (snd gen.gcurrent_path) v.v_name cur_line - in - let path = (fst gen.gcurrent_path, name) in - let cls = mk_class (get gen.gcurrent_class).cl_module path tfunc.tf_expr.epos in - if in_unsafe then cls.cl_meta <- (Meta.Unsafe,[],null_pos) :: cls.cl_meta; - - (* forward NativeGen meta for Cs target *) - if (Common.platform gen.gcon Cs) && not(is_hxgen (TClassDecl (get gen.gcurrent_class))) && Meta.has(Meta.NativeGen) (get gen.gcurrent_class).cl_meta then - cls.cl_meta <- (Meta.NativeGen,[],null_pos) :: cls.cl_meta; - - if Common.defined gen.gcon Define.EraseGenerics then begin - cls.cl_meta <- (Meta.HaxeGeneric,[],null_pos) :: cls.cl_meta - end; - cls.cl_module <- (get gen.gcurrent_class).cl_module; - cls.cl_params <- cltypes; - - let mk_this v pos = - { - (mk_field_access gen { eexpr = TConst TThis; etype = TInst(cls, extract_param_types cls.cl_params); epos = pos } v.v_name pos) - with etype = v.v_type - } - in - - let mk_this_assign v pos = - { - eexpr = TBinop(OpAssign, mk_this v pos, { eexpr = TLocal(v); etype = v.v_type; epos = pos }); - etype = v.v_type; - epos = pos - } in - - (* mk_class_field name t public pos kind params *) - let ctor_args, ctor_sig, ctor_exprs = List.fold_left (fun (ctor_args, ctor_sig, ctor_exprs) lexpr -> - match lexpr.eexpr with - | TLocal(v) -> - let cf = mk_class_field v.v_name v.v_type false lexpr.epos (Var({ v_read = AccNormal; v_write = AccNormal; })) [] in - cls.cl_fields <- PMap.add v.v_name cf cls.cl_fields; - cls.cl_ordered_fields <- cf :: cls.cl_ordered_fields; - - let ctor_v = alloc_var v.v_name v.v_type in - ((ctor_v, None) :: ctor_args, (v.v_name, false, v.v_type) :: ctor_sig, (mk_this_assign v cls.cl_pos) :: ctor_exprs) - | _ -> die "" __LOC__ - ) ([],[],[]) captured in - - (* change all captured variables to this.capturedVariable *) - let rec change_captured e = - match e.eexpr with - | TLocal v when has_var_flag v VCaptured && Hashtbl.mem captured_ht v.v_id -> - mk_this v e.epos - | _ -> Type.map_expr change_captured e - in - let func_expr = change_captured tfunc.tf_expr in - - let invokecf, invoke_field, super_args = match delegate_type with - | None -> (* no delegate *) - let ifield, sa = ft.closure_to_classfield { tfunc with tf_expr = func_expr } fexpr.etype fexpr.epos in - ifield,ifield,sa - | Some _ -> - let pos = cls.cl_pos in - let cf = mk_class_field "Delegate" (TFun(fun_args tfunc.tf_args, tfunc.tf_type)) true pos (Method MethNormal) [] in - cf.cf_expr <- Some { fexpr with eexpr = TFunction { tfunc with tf_expr = func_expr }; }; - add_class_field_flag cf CfFinal; - cls.cl_ordered_fields <- cf :: cls.cl_ordered_fields; - cls.cl_fields <- PMap.add cf.cf_name cf cls.cl_fields; - (* invoke function body: call Delegate function *) - let ibody = { - eexpr = TCall({ - eexpr = TField({ - eexpr = TConst TThis; - etype = TInst(cls, extract_param_types cls.cl_params); - epos = pos; - }, FInstance(cls, extract_param_types cls.cl_params, cf)); - etype = cf.cf_type; - epos = pos; - }, List.map (fun (v,_) -> mk_local v pos) tfunc.tf_args); - etype = tfunc.tf_type; - epos = pos - } in - let ibody = if not (ExtType.is_void tfunc.tf_type) then - mk_return ibody - else - ibody - in - let ifield, sa = ft.closure_to_classfield { tfunc with tf_expr = ibody } fexpr.etype fexpr.epos in - cf,ifield,sa - in - - (* create the constructor *) - (* todo properly abstract how type var is set *) - - cls.cl_super <- Some(ft.func_class, []); - let pos = cls.cl_pos in - let super_call = - { - eexpr = TCall({ eexpr = TConst(TSuper); etype = TInst(ft.func_class,[]); epos = pos }, super_args); - etype = gen.gcon.basic.tvoid; - epos = pos; - } in - - let ctor_type = (TFun(ctor_sig, gen.gcon.basic.tvoid)) in - let ctor = mk_class_field "new" ctor_type true cls.cl_pos (Method(MethNormal)) [] in - ctor.cf_expr <- Some( - { - eexpr = TFunction( - { - tf_args = ctor_args; - tf_type = gen.gcon.basic.tvoid; - tf_expr = { eexpr = TBlock(super_call :: ctor_exprs); etype = gen.gcon.basic.tvoid; epos = cls.cl_pos } - }); - etype = ctor_type; - epos = cls.cl_pos; - }); - cls.cl_constructor <- Some(ctor); - - (* add invoke function to the class *) - cls.cl_ordered_fields <- invoke_field :: cls.cl_ordered_fields; - cls.cl_fields <- PMap.add invoke_field.cf_name invoke_field cls.cl_fields; - add_class_field_flag invoke_field CfOverride; - - (match tvar with - | None -> () - | Some ({ v_extra = Some({v_params = _ :: _}) } as v) -> - Hashtbl.add tvar_to_cdecl v.v_id (cls,captured) - | _ -> ()); - - (* set priority as priority + 0.00001 so that this filter runs again *) - gen.gadd_to_module (TClassDecl cls) (priority +. 0.000001); - - (* if there are no captured variables, we can create a cache so subsequent calls don't need to create a new function *) - let expr, clscapt = - match captured, tparams with - | [], [] -> - let cache_var = mk_internal_name "hx" "current" in - let cache_cf = mk_class_field ~static:true cache_var (TInst(cls,[])) false func_expr.epos (Var({ v_read = AccNormal; v_write = AccNormal })) [] in - cls.cl_ordered_statics <- cache_cf :: cls.cl_ordered_statics; - cls.cl_statics <- PMap.add cache_var cache_cf cls.cl_statics; - - (* if (FuncClass.hx_current != null) FuncClass.hx_current; else (FuncClass.hx_current = new FuncClass()); *) - - (* let mk_static_field_access cl field fieldt pos = *) - let hx_current = mk_static_field_access cls cache_var (TInst(cls,[])) func_expr.epos in - - let pos = func_expr.epos in - { fexpr with - etype = hx_current.etype; - eexpr = TIf( - { - eexpr = TBinop(OpNotEq, hx_current, null (TInst(cls,[])) pos); - etype = gen.gcon.basic.tbool; - epos = pos; - }, - hx_current, - Some( - { - eexpr = TBinop(OpAssign, hx_current, { fexpr with eexpr = TNew(cls, [], captured) }); - etype = (TInst(cls,[])); - epos = pos; - })) - }, (cls,captured) - | _ -> - (* change the expression so it will be a new "added class" ( captured variables arguments ) *) - { fexpr with eexpr = TNew(cls, List.map (fun cl -> TInst(cl,[])) tparams, List.rev captured) }, (cls,captured) - in - match delegate_type with - | None -> - expr,clscapt - | Some _ -> - { - eexpr = TField(expr, FClosure(Some (cls,[]),invokecf)); (* TODO: FClosure change *) - etype = invokecf.cf_type; - epos = cls.cl_pos - }, clscapt - in - - - let run = traverse - gen - ~tparam_anon_decl:(fun v e fn -> - let _, (cls,captured) = handle_anon_func e ~tvar:v fn null_map_info None in - Hashtbl.add tvar_to_cdecl v.v_id (cls,captured) - ) - ~tparam_anon_acc:(fun v e in_tparam -> try - let cls, captured = Hashtbl.find tvar_to_cdecl v.v_id in - let captured = List.sort (fun e1 e2 -> match e1, e2 with - | { eexpr = TLocal v1 }, { eexpr = TLocal v2 } -> - compare v1.v_name v2.v_name - | _ -> die "" __LOC__) captured - in - let types = match v.v_extra with - | Some ve -> ve.v_params - | _ -> die "" __LOC__ - in - let monos = List.map (fun _ -> mk_mono()) types in - let vt = match follow v.v_type with - | TInst(_, [v]) -> v - | v -> v - in - let et = match follow e.etype with - | TInst(_, [v]) -> v - | v -> v - in - let original = apply_params types monos vt in - unify et original; - - let monos = List.map (fun t -> apply_params types (List.map (fun _ -> t_dynamic) types) t) monos in - - let passoc = List.map2 (fun tp m -> tp.ttp_class,m) types monos in - let cltparams = List.map (fun tp -> - try - snd (List.find (fun (t2,_) -> tp.ttp_class == t2) passoc) - with | Not_found -> tp.ttp_type) cls.cl_params - in - { e with eexpr = TNew(cls, cltparams, List.rev captured) } - with - | Not_found -> - if in_tparam then begin - gen.gwarning WGenerator "This expression may be invalid" e.epos; - e - end else - (* It is possible that we are recursively calling a function - that has type parameters. In this case, we must leave it be - because as soon as the new class is added to the module, - this filter will run again. By this time, the tvar-to-cdecl - hashtable will be already filled with all functions, so - it should run correctly. In this case, if it keeps failing. - we will add the "Expression may be invalid warning" like we did - before (see Issue #7118) *) - { e with eexpr = TMeta( - (Meta.Custom(":tparamcall"), [], e.epos), e - ) } - | Unify_error el -> - List.iter (fun el -> gen.gwarning WGenerator (Error.unify_error_msg (print_context()) el) e.epos) el; - gen.gwarning WGenerator "This expression may be invalid" e.epos; - e - ) - (* (handle_anon_func:texpr->tfunc->texpr) (dynamic_func_call:texpr->texpr->texpr list->texpr) *) - (fun e f info delegate_type -> fst (handle_anon_func e f info delegate_type)) - ft.dynamic_fun_call - (* (dynamic_func_call:texpr->texpr->texpr list->texpr) *) - in - gen.gexpr_filters#add name (PCustom priority) run - -(* - this submodule will provide the default implementation for the C# and Java targets. - - it will have two return types: double and dynamic, and -*) -module DoubleAndDynamicClosureImpl = -struct - let get_ctx gen parent_func_class max_arity mk_arg_exception (* e.g. new haxe.lang.ClassClosure *) = - let basic = gen.gcon.basic in - - let func_args_i i = - let rec loop i (acc) = - if i = 0 then (acc) else begin - let vfloat = alloc_var (mk_internal_name "fn" ("float" ^ string_of_int i)) basic.tfloat in - let vdyn = alloc_var (mk_internal_name "fn" ("dyn" ^ string_of_int i)) t_dynamic in - - loop (i - 1) ((vfloat, None) :: (vdyn, None) :: acc) - end - in - loop i [] - in - - let args_real_to_func args = - let arity = List.length args in - if arity >= max_arity then - [ alloc_var (mk_internal_name "fn" "dynargs") (gen.gclasses.nativearray t_dynamic), None ] - else func_args_i arity - in - - let func_sig_i i = - let rec loop i acc = - if i = 0 then acc else begin - let vfloat = mk_internal_name "fn" ("float" ^ string_of_int i) in - let vdyn = mk_internal_name "fn" ("dyn" ^ string_of_int i) in - - loop (i - 1) ( (vfloat,false,basic.tfloat) :: (vdyn,false,t_dynamic) :: acc ) - end - in - loop i [] - in - - let args_real_to_func_sig args = - let arity = List.length args in - if arity >= max_arity then - [mk_internal_name "fn" "dynargs", false, gen.gclasses.nativearray t_dynamic] - else begin - func_sig_i arity - end - in - - let rettype_real_to_func t = match run_follow gen t with - | TAbstract({ a_path = [],"Null" }, _) -> - 0,t_dynamic - | _ when like_float t && not (like_i64 t) -> - (1, basic.tfloat) - | _ -> - (0, t_dynamic) - in - - let args_real_to_func_call el (pos:pos) = - if List.length el >= max_arity then - [mk_nativearray_decl gen t_dynamic el pos] - else begin - List.fold_left (fun acc e -> - if like_float (gen.greal_type e.etype) && not (like_i64 (gen.greal_type e.etype)) then - ( e :: undefined e.epos :: acc ) - else - ( null basic.tfloat e.epos :: e :: acc ) - ) ([]) (List.rev el) - end - in - - let get_args_func args changed_args pos = - let arity = List.length args in - let mk_const const elocal t = - match const with - | None -> - mk_cast t elocal - | Some const -> - { eexpr = TIf( - { elocal with eexpr = TBinop(Ast.OpEq, elocal, null elocal.etype elocal.epos); etype = basic.tbool }, - const, - Some ( mk_cast t elocal ) - ); etype = t; epos = elocal.epos } - in - - if arity >= max_arity then begin - let varray = match changed_args with | [v,_] -> v | _ -> die "" __LOC__ in - let varray_local = mk_local varray pos in - let mk_varray i = { eexpr = TArray(varray_local, make_int gen.gcon.basic i pos); etype = t_dynamic; epos = pos } in - let el = - snd (List.fold_left (fun (count,acc) (v,const) -> - (count + 1, (mk (TVar(v, Some(mk_const const (mk_varray count) v.v_type))) basic.tvoid pos) :: acc) - ) (0, []) args) - in - List.rev el - end else begin - let _, dyn_args, float_args = List.fold_left (fun (count,fargs, dargs) arg -> - if count land 1 = 0 then - (count + 1, fargs, arg :: dargs) - else - (count + 1, arg :: fargs, dargs) - ) (1,[],[]) (List.rev changed_args) in - - let rec loop acc args fargs dargs = - match args, fargs, dargs with - | [], [], [] -> acc - | (v,const) :: args, (vf,_) :: fargs, (vd,_) :: dargs -> - let acc = { eexpr = TVar(v, Some( - { - eexpr = TIf( - { eexpr = TBinop(Ast.OpEq, mk_local vd pos, undefined pos); etype = basic.tbool; epos = pos }, - mk_cast v.v_type (mk_local vf pos), - Some ( mk_const const (mk_local vd pos) v.v_type ) - ); - etype = v.v_type; - epos = pos - } )); etype = basic.tvoid; epos = pos } :: acc in - loop acc args fargs dargs - | _ -> die "" __LOC__ - in - - loop [] args float_args dyn_args - end - in - - let closure_to_classfield tfunc old_sig pos = - (* change function signature *) - let old_args = tfunc.tf_args in - let changed_args = args_real_to_func old_args in - - (* - FIXME properly handle int64 cases, which will break here (because of inference to int) - UPDATE: the fix will be that Int64 won't be a typedef to Float/Int - *) - let changed_sig, arity, type_number, changed_sig_ret, is_void, is_dynamic_func = match follow old_sig with - | TFun(_sig, ret) -> - let type_n, ret_t = rettype_real_to_func ret in - let arity = List.length _sig in - let is_dynamic_func = arity >= max_arity in - let ret_t = if is_dynamic_func then t_dynamic else ret_t in - - (TFun(args_real_to_func_sig _sig, ret_t), arity, type_n, ret_t, ExtType.is_void ret, is_dynamic_func) - | _ -> (print_endline (s_type (print_context()) (follow old_sig) )); die "" __LOC__ - in - - let tf_expr = if is_void then begin - let rec map e = - match e.eexpr with - | TReturn None -> - mk_return (null t_dynamic e.epos) - | _ -> Type.map_expr map e - in - let e = mk_block (map tfunc.tf_expr) in - match e.eexpr with - | TBlock bl -> { e with eexpr = TBlock (bl @ [mk_return (null t_dynamic e.epos)]) } - | _ -> die "" __LOC__ - end else tfunc.tf_expr in - - let changed_sig_ret = if is_dynamic_func then t_dynamic else changed_sig_ret in - - (* get real arguments on top of function body *) - let get_args = get_args_func tfunc.tf_args changed_args pos in - (* - FIXME HACK: in order to be able to run the filters that have already ran for this piece of code, - we will cheat and run it as if it was the whole code - We could just make ClosuresToClass run before TArrayTransform, but we cannot because of the - dependency between ClosuresToClass (after DynamicFieldAccess, and before TArrayTransform) - - maybe a way to solve this would be to add an "until" field to run_from - *) - let real_get_args = gen.gexpr_filters#run (mk (TBlock get_args) basic.tvoid pos) in - - let func_expr = Type.concat real_get_args tf_expr in - - (* set invoke function *) - (* todo properly abstract how naming for invoke is made *) - let invoke_name = if is_dynamic_func then "invokeDynamic" else ("invoke" ^ (string_of_int arity) ^ (if type_number = 0 then "_o" else "_f")) in - let invoke_name = mk_internal_name "hx" invoke_name in - let invoke_field = mk_class_field invoke_name changed_sig false func_expr.epos (Method(MethNormal)) [] in - let invoke_fun = { - eexpr = TFunction { - tf_args = changed_args; - tf_type = changed_sig_ret; - tf_expr = func_expr; - }; - etype = changed_sig; - epos = func_expr.epos; - } in - invoke_field.cf_expr <- Some invoke_fun; - - invoke_field, [ - make_int gen.gcon.basic arity pos; - make_int gen.gcon.basic type_number pos; - ] - in - - let dynamic_fun_call call_expr = - let tc, params = match call_expr.eexpr with - | TCall(tc, params) -> tc,wrap_rest_args gen tc.etype params tc.epos - | _ -> die "" __LOC__ - in - let ct = gen.greal_type call_expr.etype in - let postfix, ret_t = - if like_float ct && not (like_i64 ct) then - "_f", gen.gcon.basic.tfloat - else - "_o", t_dynamic - in - let params_len = List.length params in - let ret_t = if params_len >= max_arity then t_dynamic else ret_t in - - let invoke_fun = if params_len >= max_arity then "invokeDynamic" else "invoke" ^ (string_of_int params_len) ^ postfix in - let invoke_fun = mk_internal_name "hx" invoke_fun in - let fun_t = match follow tc.etype with - | TFun(_sig, _) -> - TFun(args_real_to_func_sig _sig, ret_t) - | _ -> - let i = ref 0 in - let _sig = List.map (fun p -> let name = "arg" ^ (string_of_int !i) in incr i; (name,false,p.etype) ) params in - TFun(args_real_to_func_sig _sig, ret_t) - in - - let may_cast = match follow call_expr.etype with - | TAbstract ({ a_path = ([], "Void") },[]) -> (fun e -> e) - | _ -> mk_cast call_expr.etype - in - - may_cast - { - eexpr = TCall( - { (mk_field_access gen { tc with etype = gen.greal_type tc.etype } invoke_fun tc.epos) with etype = fun_t }, - args_real_to_func_call params call_expr.epos - ); - etype = ret_t; - epos = call_expr.epos - } - in - - let iname i is_float = - let postfix = if is_float then "_f" else "_o" in - mk_internal_name "hx" ("invoke" ^ string_of_int i) ^ postfix - in - - let map_base_classfields cl map_fn = - let pos = cl.cl_pos in - let this_t = TInst(cl,extract_param_types cl.cl_params) in - let this = { eexpr = TConst(TThis); etype = this_t; epos = pos } in - let mk_this field t = { (mk_field_access gen this field pos) with etype = t } in - - let mk_invoke_i i is_float = - let cf = mk_class_field (iname i is_float) (TFun(func_sig_i i, if is_float then basic.tfloat else t_dynamic)) false pos (Method MethNormal) [] in - cf - in - - let type_name = mk_internal_name "fn" "type" in - let dynamic_arg = alloc_var (mk_internal_name "fn" "dynargs") (gen.gclasses.nativearray t_dynamic) in - - let mk_invoke_complete_i i is_float = - - (* let arity = i in *) - let args = func_args_i i in - - (* api fn *) - - (* only cast if needed *) - let mk_cast tto efrom = gen.ghandle_cast (gen.greal_type tto) (gen.greal_type efrom.etype) efrom in - let api i t const = - let vf, _ = List.nth args (i * 2) in - let vo, _ = List.nth args (i * 2 + 1) in - - let needs_cast, is_float = match t, like_float t && not (like_i64 t) with - | TAbstract({ a_path = ([], "Float") },[]), _ -> false, true - | _, true -> true, true - | _ -> false,false - in - - let olocal = mk_local vo pos in - let flocal = mk_local vf pos in - - let get_from_obj e = match const with - | None -> mk_cast t e - | Some tc -> - { - eexpr = TIf( - { eexpr = TBinop(Ast.OpEq, olocal, null t_dynamic pos); etype = basic.tbool; epos = pos } , - { eexpr = TConst(tc); etype = t; epos = pos }, - Some (mk_cast t e) - ); - etype = t; - epos = pos; - } - in - - { - eexpr = TIf( - { eexpr = TBinop(Ast.OpEq, olocal, undefined pos); etype = basic.tbool; epos = pos }, - (if needs_cast then mk_cast t flocal else flocal), - Some ( get_from_obj olocal ) - ); - etype = t; - epos = pos - } - in - (* end of api fn *) - - let ret = if is_float then basic.tfloat else t_dynamic in - - let fn_expr = map_fn i ret (List.map fst args) api in - - let t = TFun(fun_args args, ret) in - - let tfunction = - { - eexpr = TFunction({ - tf_args = args; - tf_type = ret; - tf_expr = - mk_block fn_expr - }); - etype = t; - epos = pos; - } - in - - let cf = mk_invoke_i i is_float in - cf.cf_expr <- Some tfunction; - cf - in - - let rec loop i cfs = - if i < 0 then cfs else begin - (*let mk_invoke_complete_i i is_float =*) - (mk_invoke_complete_i i false) :: (mk_invoke_complete_i i true) :: (loop (i-1) cfs) - end - in - - let cfs = loop max_arity [] in - - let switch = - let api i t const = - match i with - | -1 -> - mk_local dynamic_arg pos - | _ -> - mk_cast t { - eexpr = TArray( - mk_local dynamic_arg pos, - { eexpr = TConst(TInt(Int32.of_int i)); etype = basic.tint; epos = pos }); - etype = t; - epos = pos; - } - in - map_fn (-1) t_dynamic [dynamic_arg] api - in - - let args = [dynamic_arg, None] in - let dyn_t = TFun(fun_args args, t_dynamic) in - let dyn_cf = mk_class_field (mk_internal_name "hx" "invokeDynamic") dyn_t false pos (Method MethNormal) [] in - - dyn_cf.cf_expr <- Some { - eexpr = TFunction { - tf_args = args; - tf_type = t_dynamic; - tf_expr = mk_block switch - }; - etype = dyn_t; - epos = pos; - }; - - let additional_cfs = begin - let new_t = TFun(["arity", false, basic.tint; "type", false, basic.tint],basic.tvoid) in - let new_cf = mk_class_field "new" (new_t) true pos (Method MethNormal) [] in - let v_arity, v_type = alloc_var "arity" basic.tint, alloc_var "type" basic.tint in - let mk_assign v field = mk (TBinop (OpAssign, mk_this field v.v_type, mk_local v pos)) v.v_type pos in - - let arity_name = mk_internal_name "hx" "arity" in - new_cf.cf_expr <- Some { - eexpr = TFunction({ - tf_args = [v_arity, None; v_type, None]; - tf_type = basic.tvoid; - tf_expr = - { - eexpr = TBlock([ - mk_assign v_type type_name; - mk_assign v_arity arity_name - ]); - etype = basic.tvoid; - epos = pos; - } - }); - etype = new_t; - epos = pos; - }; - - [ - new_cf; - mk_class_field type_name basic.tint true pos (Var { v_read = AccNormal; v_write = AccNormal }) []; - mk_class_field arity_name basic.tint true pos (Var { v_read = AccNormal; v_write = AccNormal }) []; - ] - end in - - dyn_cf :: (additional_cfs @ cfs) - in - - begin - (* - setup fields for the abstract implementation of the Function class - - new(arity, type) - { - this.arity = arity; - this.type = type; - } - - hx::invokeX_f|o (where X is from 0 to max_arity) (args) - { - if (this.type == 0|1) return invokeX_o|f(args); else throw "Invalid number of arguments." - } - - hx::invokeDynamic, which will work in the same way - *) - let cl = parent_func_class in - let pos = cl.cl_pos in - - let mk_dyn_call arity api = - let zero = make_float gen.gcon.basic "0.0" pos in - let rec loop i acc = - if i = 0 then - acc - else begin - let arr = api (i - 1) t_dynamic None in - loop (i - 1) (zero :: arr :: acc) - end - in - loop arity [] - in - - let this = mk (TConst TThis) (TInst (cl, extract_param_types cl.cl_params)) pos in - let mk_this field t = { (mk_field_access gen this field pos) with etype = t } in - - let mk_invoke_switch i api = - let t = TFun (func_sig_i i, t_dynamic) in - (* case i: return this.invokeX_o(0, 0, 0, 0, 0, ... arg[0], args[1]....); *) - { - case_patterns = [make_int gen.gcon.basic i pos]; - case_expr = mk_return (mk (TCall(mk_this (iname i false) t, mk_dyn_call i api)) t_dynamic pos) - } - in - let rec loop_cases api arity acc = - if arity < 0 then - acc - else - loop_cases api (arity - 1) (mk_invoke_switch arity api :: acc) - in - - let type_name = mk_internal_name "fn" "type" in - let mk_expr i is_float vars = - let call_expr = - let call_t = TFun(List.map (fun v -> (v.v_name, false, v.v_type)) vars, if is_float then t_dynamic else basic.tfloat) in - { - eexpr = TCall(mk_this (iname i (not is_float)) call_t, List.map (fun v -> mk_local v pos) vars); - etype = if is_float then t_dynamic else basic.tfloat; - epos = pos - } - in - { - eexpr = TIf( - mk (TBinop (Ast.OpNotEq, mk_this type_name basic.tint, (make_int gen.gcon.basic (if is_float then 0 else 1) pos))) basic.tbool pos, - make_throw (mk_arg_exception "Wrong number of arguments" pos) pos, - Some (mk_return call_expr) - ); - etype = t_dynamic; - epos = pos; - } - in - - let arities_processed = Hashtbl.create 10 in - let max_arity = ref 0 in - - let map_fn cur_arity fun_ret_type vars (api:int->t->tconstant option->texpr) = - let is_float = like_float fun_ret_type && not (like_i64 fun_ret_type) in - match cur_arity with - | -1 -> - let dynargs = api (-1) t_dynamic None in - - (* (dynargs == null) ? 0 : dynargs.length *) - let switch_cond = { - eexpr = TIf( - mk (TBinop (OpEq, dynargs, null dynargs.etype pos)) basic.tbool pos, - mk (TConst (TInt Int32.zero)) basic.tint pos, - Some (gen.gclasses.nativearray_len dynargs pos)); - etype = basic.tint; - epos = pos; - } in - - let switch = mk_switch switch_cond (loop_cases api !max_arity []) (Some(make_throw (mk_arg_exception "Too many arguments" pos) pos)) true in - { - eexpr = TSwitch switch; - etype = basic.tvoid; - epos = pos; - } - | _ -> - if not (Hashtbl.mem arities_processed cur_arity) then begin - Hashtbl.add arities_processed cur_arity true; - if cur_arity > !max_arity then max_arity := cur_arity - end; - - mk_expr cur_arity is_float vars - in - - let cfs = map_base_classfields cl map_fn in - List.iter (fun cf -> - if cf.cf_name = "new" then - parent_func_class.cl_constructor <- Some cf - else - parent_func_class.cl_fields <- PMap.add cf.cf_name cf parent_func_class.cl_fields - ) cfs; - parent_func_class.cl_ordered_fields <- (List.filter (fun cf -> cf.cf_name <> "new") cfs) @ parent_func_class.cl_ordered_fields - end; - - { - func_class = parent_func_class; - closure_to_classfield = closure_to_classfield; - dynamic_fun_call = dynamic_fun_call; - map_base_classfields = map_base_classfields; - } -end;; diff --git a/src/codegen/gencommon/dynamicFieldAccess.ml b/src/codegen/gencommon/dynamicFieldAccess.ml deleted file mode 100644 index 78fc88c39ba..00000000000 --- a/src/codegen/gencommon/dynamicFieldAccess.ml +++ /dev/null @@ -1,132 +0,0 @@ -(* - The Haxe Compiler - Copyright (C) 2005-2019 Haxe Foundation - - This program is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License - as published by the Free Software Foundation; either version 2 - of the License, or (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. -*) -open Option -open Ast -open Type -open Gencommon - -(* - This module will filter every dynamic field access in haxe. - - On platforms that do not support dynamic access, it is with this that you should - replace dynamic calls with x.field / Reflect.setField calls, and guess what - - this is the default implemenation! - Actually there is a problem with Reflect.setField because it returns void, which is a bad thing for us, - so even in the default implementation, the function call should be specified to a Reflect.setField version that returns - the value that was set - - (TODO: should it be separated?) - As a plus, the default implementation adds something that doesn't hurt anybody, it looks for - TAnon with ClassStatics / EnumStatics field accesses and transforms them into real static calls. - This means it will take this - - var m = Math; - for (i in 0...1000) m.cos(10); - - which is an optimization in dynamic platforms, but performs horribly on strongly typed platforms - and transform into: - - var m = Math; - for (i in 0...1000) Math.cos(10); - - depends on: - (ok) must run AFTER Binop/Unop handler - so Unops / Binops are already unrolled -*) -let name = "dynamic_field_access" -let priority = solve_deps name [DAfter DynamicOperators.priority] - -(* - is_dynamic (expr) (field_access_expr) (field) : a function that indicates if the field access should be changed - change_expr (expr) (field_access_expr) (field) (setting expr) (is_unsafe) : changes the expression - call_expr (expr) (field_access_expr) (field) (call_params) : changes a call expression -*) -let configure gen (is_dynamic:texpr->Type.tfield_access->bool) (change_expr:texpr->texpr->string->texpr option->bool->texpr) (call_expr:texpr->texpr->string->texpr list->texpr) = - let is_nondynamic_tparam fexpr f = match follow fexpr.etype with - | TInst({ cl_kind = KTypeParameter(ttp) }, _) -> - List.exists (fun t -> not (is_dynamic { fexpr with etype = t } f)) (get_constraints ttp) - | _ -> false - in - - let rec run e = - match e.eexpr with - (* class types *) - | TField(fexpr, f) when is_nondynamic_tparam fexpr f -> - (match follow fexpr.etype with - | TInst( ({ cl_kind = KTypeParameter(ttp) } as tp_cl), tp_tl) -> - let t = apply_params tp_cl.cl_params tp_tl (List.find (fun t -> not (is_dynamic { fexpr with etype = t } f)) (get_constraints ttp)) in - { e with eexpr = TField(mk_cast t (run fexpr), f) } - | _ -> Globals.die "" __LOC__) - - | TField(fexpr, f) when is_some (anon_class fexpr.etype) -> - let decl = get (anon_class fexpr.etype) in - let name = field_name f in - (try - match decl with - | TClassDecl cl -> - let cf = PMap.find name cl.cl_statics in - { e with eexpr = TField ({ fexpr with eexpr = TTypeExpr decl }, FStatic (cl, cf)) } - | TEnumDecl en -> - let ef = PMap.find name en.e_constrs in - { e with eexpr = TField ({ fexpr with eexpr = TTypeExpr decl }, FEnum (en, ef)) } - | TAbstractDecl _ (* abstracts don't have TFields *) - | TTypeDecl _ -> (* anon_class doesn't return TTypeDecl *) - Globals.die "" __LOC__ - with Not_found -> - match f with - | FStatic (cl, cf) when has_class_field_flag cf CfExtern -> - { e with eexpr = TField ({ fexpr with eexpr = TTypeExpr decl }, FStatic (cl, cf)) } - | _ -> - change_expr e { fexpr with eexpr = TTypeExpr decl } (field_name f) None true) - - | TField (fexpr, f) when is_dynamic fexpr f -> - change_expr e (run fexpr) (field_name f) None true - - | TCall ({ eexpr = TField (_, FStatic({ cl_path = ([], "Reflect") }, { cf_name = "field" })) }, [obj; { eexpr = TConst (TString field) }]) -> - let t = match gen.greal_type obj.etype with - | TDynamic _ | TAnon _ | TMono _ -> t_dynamic - | t -> t - in - change_expr (mk_field_access gen { obj with etype = t } field obj.epos) (run obj) field None false - - | TCall ({ eexpr = TField (_, FStatic({ cl_path = ([], "Reflect") }, { cf_name = "setField" } )) }, [obj; { eexpr = TConst(TString field) }; evalue]) -> - change_expr (mk_field_access gen obj field obj.epos) (run obj) field (Some (run evalue)) false - - | TBinop (OpAssign, { eexpr = TField(fexpr, f) }, evalue) when is_dynamic fexpr f -> - change_expr e (run fexpr) (field_name f) (Some (run evalue)) true - - | TBinop (OpAssign, { eexpr = TField(fexpr, f) }, evalue) -> - (match field_access_esp gen fexpr.etype f with - | FClassField(_,_,_,cf,false,t,_) when (try PMap.find cf.cf_name gen.gbase_class_fields == cf with Not_found -> false) -> - change_expr e (run fexpr) (field_name f) (Some (run evalue)) true - | _ -> - Type.map_expr run e) - - | TBinop (OpAssignOp _, { eexpr = TField (fexpr, f) }, _) when is_dynamic fexpr f -> - Globals.die "" __LOC__ (* this case shouldn't happen *) - | TUnop (Increment, _, { eexpr = TField (({ eexpr = TLocal _ } as fexpr), f)}) - | TUnop (Decrement, _, { eexpr = TField (({ eexpr = TLocal _ } as fexpr), f)}) when is_dynamic fexpr f -> - Globals.die "" __LOC__ (* this case shouldn't happen *) - - | TCall ({ eexpr = TField (fexpr, f) }, params) when is_dynamic fexpr f && (not (is_nondynamic_tparam fexpr f)) -> - call_expr e (run fexpr) (field_name f) (List.map run params) - - | _ -> - Type.map_expr run e - in - gen.gexpr_filters#add name (PCustom priority) run diff --git a/src/codegen/gencommon/dynamicOperators.ml b/src/codegen/gencommon/dynamicOperators.ml deleted file mode 100644 index e53add85c00..00000000000 --- a/src/codegen/gencommon/dynamicOperators.ml +++ /dev/null @@ -1,189 +0,0 @@ -(* - The Haxe Compiler - Copyright (C) 2005-2019 Haxe Foundation - - This program is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License - as published by the Free Software Foundation; either version 2 - of the License, or (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. -*) -open Common -open Ast -open Type -open Texpr.Builder -open Gencommon - -(* ******************************************* *) -(* Dynamic Binop/Unop handler *) -(* ******************************************* *) -(* - On some languages there is limited support for operations on - dynamic variables, so those operations must be changed. - - There are 5 types of binary operators: - 1 - can take any variable and returns a bool (== and !=) - 2 - can take either a string, or a number and returns either a bool or the underlying type ( >, < for bool and + for returning its type) - 3 - take numbers and return a number ( *, /, ...) - 4 - take ints and return an int (bit manipulation) - 5 - take a bool and returns a bool ( &&, || ...) - - On the default implementation, type 1 and the plus function will be handled with a function call; - Type 2 will be handled with the parameter "compare_handler", which will do something like Reflect.compare(x1, x2); - Types 3, 4 and 5 will perform a cast to double, int and bool, which will then be handled normally by the platform - - Unary operators are the most difficult to handle correctly. - With unary operators, there are 2 types: - - 1 - can take a number, changes and returns the result (++, --, ~) - 2 - can take a number (-) or bool (!), and returns the result - - The first case is much trickier, because it doesn't seem a good idea to change any variable to double just because it is dynamic, - but this is how we will handle right now. - something like that: - - var x:Dynamic = 10; - x++; - - will be: - object x = 10; - x = ((IConvertible)x).ToDouble(null) + 1; - - depends on: - (syntax) must run before expression/statment normalization because it may generate complex expressions - must run before OverloadingConstructor due to later priority conflicts. Since ExpressionUnwrap is only - defined afterwards, we will set this value with absolute values -*) -let init com handle_strings (should_change:texpr->bool) (equals_handler:texpr->texpr->texpr) (dyn_plus_handler:texpr->texpr->texpr->texpr) (compare_handler:Ast.binop->texpr->texpr->texpr->texpr) = - let get_etype_one e = - if like_int e.etype then - make_int com.basic 1 e.epos - else - make_float com.basic "1.0" e.epos - in - let rec run e = - match e.eexpr with - | TBinop (OpAssignOp op, e1, e2) when should_change e -> (* e1 will never contain another TBinop *) - (match e1.eexpr with - | TLocal _ -> - mk_paren { e with eexpr = TBinop(OpAssign, e1, run { e with eexpr = TBinop(op, e1, e2) }) } - | TField _ | TArray _ -> - let eleft, rest = - match e1.eexpr with - | TField(ef, f) -> - let v = mk_temp "dynop" ef.etype in - { e1 with eexpr = TField (mk_local v ef.epos, f) }, [mk (TVar (v, Some (run ef))) com.basic.tvoid ef.epos] - | TArray(e1a, e2a) -> - let v = mk_temp "dynop" e1a.etype in - let v2 = mk_temp "dynopi" e2a.etype in - { e1 with eexpr = TArray(mk_local v e1a.epos, mk_local v2 e2a.epos) }, [ - (mk (TVar (v, Some (run e1a))) com.basic.tvoid e1.epos); - (mk (TVar (v2, Some (run e2a))) com.basic.tvoid e1.epos) - ] - | _ -> Globals.die "" __LOC__ - in - { e with eexpr = TBlock (rest @ [{ e with eexpr = TBinop (OpAssign, eleft, run { e with eexpr = TBinop (op, eleft, e2) }) }]) } - | _ -> - Globals.die "" __LOC__) - - | TBinop (OpAssign, e1, e2) - | TBinop (OpInterval, e1, e2) -> - Type.map_expr run e - - | TBinop (op, e1, e2) when should_change e -> - (match op with - | OpEq -> (* type 1 *) - equals_handler (run e1) (run e2) - | OpNotEq -> (* != -> !equals() *) - mk_parent (mk (TUnop (Not, Prefix, (equals_handler (run e1) (run e2)))) com.basic.tbool e.epos) - | OpAdd -> - if handle_strings && (is_string e.etype || is_string e1.etype || is_string e2.etype) then - { e with eexpr = TBinop (op, mk_cast com.basic.tstring (run e1), mk_cast com.basic.tstring (run e2)) } - else - dyn_plus_handler e (run e1) (run e2) - | OpGt | OpGte | OpLt | OpLte -> (* type 2 *) - compare_handler op e (run e1) (run e2) - | OpMult | OpDiv | OpSub | OpMod -> (* always cast everything to double *) - let etype = (get_etype_one e).etype in - { e with eexpr = TBinop (op, mk_cast etype (run e1), mk_cast etype (run e2)) } - | OpBoolAnd | OpBoolOr -> - { e with eexpr = TBinop (op, mk_cast com.basic.tbool (run e1), mk_cast com.basic.tbool (run e2)) } - | OpAnd | OpOr | OpXor | OpShl | OpShr | OpUShr -> - { e with eexpr = TBinop (op, mk_cast com.basic.tint (run e1), mk_cast com.basic.tint (run e2)) } - | OpAssign | OpAssignOp _ | OpInterval | OpArrow | OpIn | OpNullCoal -> - Globals.die "" __LOC__) - - | TUnop (Increment as op, flag, e1) - | TUnop (Decrement as op, flag, e1) when should_change e -> - (* - some naming definitions: - * ret => the returning variable - * _g => the get body - * getvar => the get variable expr - - This will work like this: - - if e1 is a TField, set _g = get body, getvar = (get body).varname - - if Prefix, return getvar = getvar + 1.0 - - if Postfix, set ret = getvar; getvar = getvar + 1.0; ret; - *) - let one = get_etype_one e in - let etype = one.etype in - let op = (match op with Increment -> OpAdd | Decrement -> OpSub | _ -> Globals.die "" __LOC__) in - - let block = - let vars, getvar = - match e1.eexpr with - | TField (fexpr, field) -> - let tmp = mk_temp "getvar" fexpr.etype in - let var = mk (TVar (tmp, Some (run fexpr))) com.basic.tvoid e.epos in - ([var], mk (TField (make_local tmp fexpr.epos, field)) etype e1.epos) - | _ -> - ([], e1) - in - match flag with - | Prefix -> - vars @ [ - mk_cast etype { e with eexpr = TBinop(OpAssign, getvar, binop op (mk_cast etype getvar) one etype e.epos); etype = getvar.etype } - ] - | Postfix -> - let ret = mk_temp "ret" etype in - let retlocal = make_local ret e.epos in - vars @ [ - mk (TVar (ret, Some (mk_cast etype getvar))) com.basic.tvoid e.epos; - { e with eexpr = TBinop (OpAssign, getvar, binop op retlocal one getvar.etype e.epos) }; - retlocal - ] - in - mk (TBlock block) etype e.epos - - | TUnop (op, flag, e1) when should_change e -> - let etype = match op with - | Not -> com.basic.tbool - | Neg -> - if like_float e.etype || like_i64 e.etype then - e.etype - else - com.basic.tfloat - | _ -> com.basic.tint - in - mk_parent (mk (TUnop (op, flag, mk_cast etype (run e1))) etype e.epos) - - | _ -> - Type.map_expr run e - in - run - -let name = "dyn_ops" -let priority = 0.0 - -let configure gen ~handle_strings should_change equals_handler dyn_plus_handler compare_handler = - let run = init gen.gcon handle_strings should_change equals_handler dyn_plus_handler compare_handler in - gen.gexpr_filters#add name (PCustom priority) run diff --git a/src/codegen/gencommon/enumToClass.ml b/src/codegen/gencommon/enumToClass.ml deleted file mode 100644 index 4c1051d43f7..00000000000 --- a/src/codegen/gencommon/enumToClass.ml +++ /dev/null @@ -1,301 +0,0 @@ -(* - The Haxe Compiler - Copyright (C) 2005-2019 Haxe Foundation - - This program is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License - as published by the Free Software Foundation; either version 2 - of the License, or (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. -*) -open Common -open Globals -open Ast -open Type -open Texpr.Builder -open Gencommon - -(* ******************************************* *) -(* EnumToClass *) -(* ******************************************* *) -(* - For languages that don't support parameterized enums and/or metadata in enums, we need to transform - enums into normal classes. This is done at the first module pass by creating new classes with the same - path inside the modules, and removing the actual enum module by setting it as en extern. - - * The target must create its own strategy to deal with reflection. As it is right now, we will have a base class - which the class will extend, create @:$IsEnum metadata for the class, and create @:alias() metadatas for the fields, - with their tag order (as a string) as their alias. If you are using ReflectionCFs, then you don't have to worry - about that, as it's already generating all information needed by the haxe runtime. - so they can be -*) -let name = "enum_to_class" -let priority = solve_deps name [] - -type t = { - ec_tbl : (path, tclass) Hashtbl.t; -} - -let new_t () = { - ec_tbl = Hashtbl.create 10 -} - -(* ******************************************* *) -(* EnumToClassModf *) -(* ******************************************* *) -(* - The actual Module Filter that will transform the enum into a class - - dependencies: - Should run before ReflectionCFs, in order to enable proper reflection access. - Should run before RealTypeParams.RealTypeParamsModf, since generic enums must be first converted to generic classes - It needs that the target platform implements __array__() as a shortcut to declare haxe.ds.Vector -*) -module EnumToClassModf = -struct - let name = "enum_to_class_mod" - let priority = solve_deps name [DBefore ReflectionCFs.priority; DBefore RealTypeParams.RealTypeParamsModf.priority] - - let pmap_exists fn pmap = try PMap.iter (fun a b -> if fn a b then raise Exit) pmap; false with | Exit -> true - - let has_any_meta en = - let has_meta meta = List.exists (fun (m,_,_) -> match m with Meta.Custom _ -> true | _ -> false) meta in - has_meta en.e_meta || pmap_exists (fun _ ef -> has_meta ef.ef_meta) en.e_constrs - - let convert gen t base_class base_param_class en = - let handle_type_params = false in (* TODO: look into this *) - let basic = gen.gcon.basic in - let pos = en.e_pos in - - (* create the class *) - let cl = mk_class en.e_module en.e_path pos in - Hashtbl.add t.ec_tbl en.e_path cl; - - (match Texpr.build_metadata gen.gcon.basic (TEnumDecl en) with - | Some expr -> - let cf = mk_class_field ~static:true "__meta__" expr.etype false expr.epos (Var { v_read = AccNormal; v_write = AccNormal }) [] in - cf.cf_expr <- Some expr; - cl.cl_statics <- PMap.add "__meta__" cf cl.cl_statics; - cl.cl_ordered_statics <- cf :: cl.cl_ordered_statics - | _ -> () - ); - - let super, has_params = if Meta.has Meta.FlatEnum en.e_meta then base_class, false else base_param_class, true in - - cl.cl_super <- Some(super,[]); - if en.e_extern then add_class_flag cl CExtern; - en.e_meta <- (Meta.Class, [], pos) :: en.e_meta; - cl.cl_module <- en.e_module; - cl.cl_meta <- ( Meta.Enum, [], pos ) :: cl.cl_meta; - - (match gen.gcon.platform with - | Cs when Common.defined gen.gcon Define.CoreApiSerialize -> - cl.cl_meta <- ( Meta.Meta, [ (efield( (EConst (Ident "System"), null_pos ), "Serializable" ), null_pos) ], null_pos ) :: cl.cl_meta - | _ -> ()); - let c_types = - if handle_type_params then - List.map clone_param en.e_params - else - [] - in - - cl.cl_params <- c_types; - - let i = ref 0 in - let cfs = List.map (fun name -> - let ef = PMap.find name en.e_constrs in - let pos = ef.ef_pos in - let old_i = !i in - incr i; - - let cf = match follow ef.ef_type with - | TFun(params,ret) -> - let dup_types = - if handle_type_params then - List.map clone_param en.e_params - else - [] - in - - let ef_type = - let fn, types = if handle_type_params then extract_param_type, dup_types else (fun _ -> t_dynamic), en.e_params in - let t = apply_params en.e_params (List.map fn types) ef.ef_type in - apply_params ef.ef_params (List.map fn ef.ef_params) t - in - - let params, ret = get_fun ef_type in - let cf_params = if handle_type_params then dup_types @ ef.ef_params else [] in - - let cf = mk_class_field name ef_type true pos (Method MethNormal) cf_params in - cf.cf_meta <- []; - - let tf_args = List.map (fun (name,opt,t) -> (alloc_var name t, if opt then Some (Texpr.Builder.make_null t null_pos) else None) ) params in - let arr_decl = mk_nativearray_decl gen t_dynamic (List.map (fun (v,_) -> mk_local v pos) tf_args) pos in - let expr = { - eexpr = TFunction({ - tf_args = tf_args; - tf_type = ret; - tf_expr = mk_block ( mk_return { eexpr = TNew(cl,extract_param_types dup_types, [make_int gen.gcon.basic old_i pos; arr_decl] ); etype = TInst(cl, extract_param_types dup_types); epos = pos } ); - }); - etype = ef_type; - epos = pos - } in - cf.cf_expr <- Some expr; - cf - | _ -> - let actual_t = match follow ef.ef_type with - | TEnum(e, p) -> TEnum(e, List.map (fun _ -> t_dynamic) p) - | _ -> die "" __LOC__ - in - let cf = mk_class_field name actual_t true pos (Var { v_read = AccNormal; v_write = AccNever }) [] in - let args = if has_params then - [make_int gen.gcon.basic old_i pos; null (gen.gclasses.nativearray t_dynamic) pos] - else - [make_int gen.gcon.basic old_i pos] - in - cf.cf_meta <- [Meta.ReadOnly,[],pos]; - cf.cf_expr <- Some { - eexpr = TNew(cl, List.map (fun _ -> t_empty) cl.cl_params, args); - etype = TInst(cl, List.map (fun _ -> t_empty) cl.cl_params); - epos = pos; - }; - cf - in - cl.cl_statics <- PMap.add cf.cf_name cf cl.cl_statics; - cf - ) en.e_names in - let constructs_cf = mk_class_field ~static:true "__hx_constructs" (gen.gclasses.nativearray basic.tstring) true pos (Var { v_read = AccNormal; v_write = AccNever }) [] in - constructs_cf.cf_meta <- [Meta.ReadOnly,[],pos]; - constructs_cf.cf_expr <- Some (mk_nativearray_decl gen basic.tstring (List.map (fun s -> { eexpr = TConst(TString s); etype = basic.tstring; epos = pos }) en.e_names) pos); - - cl.cl_ordered_statics <- constructs_cf :: cfs @ cl.cl_ordered_statics ; - cl.cl_statics <- PMap.add "__hx_constructs" constructs_cf cl.cl_statics; - - let getTag_cf_type = tfun [] basic.tstring in - let getTag_cf = mk_class_field "getTag" getTag_cf_type true pos (Method MethNormal) [] in - add_class_field_flag getTag_cf CfFinal; - getTag_cf.cf_expr <- Some { - eexpr = TFunction { - tf_args = []; - tf_type = basic.tstring; - tf_expr = mk_return ( - let e_constructs = mk_static_field_access_infer cl "__hx_constructs" pos [] in - let e_this = mk (TConst TThis) (TInst (cl,[])) pos in - let e_index = mk_field_access gen e_this "index" pos in - { - eexpr = TArray(e_constructs,e_index); - etype = basic.tstring; - epos = pos; - } - ) - }; - etype = getTag_cf_type; - epos = pos; - }; - - cl.cl_ordered_fields <- getTag_cf :: cl.cl_ordered_fields ; - cl.cl_fields <- PMap.add "getTag" getTag_cf cl.cl_fields; - add_class_field_flag getTag_cf CfOverride; - cl.cl_meta <- (Meta.NativeGen,[],cl.cl_pos) :: cl.cl_meta; - gen.gadd_to_module (TClassDecl cl) (max_dep); - - TEnumDecl en - - (* - traverse - gen - gen context - convert_all : bool - should we convert all enums? If set, convert_if_has_meta will be ignored. - convert_if_has_meta : bool - should we convert only if it has meta? - enum_base_class : tclass - the enum base class. - should_be_hxgen : bool - should the created enum be hxgen? - *) - let configure gen t convert_all convert_if_has_meta enum_base_class param_enum_class = - let convert e = convert gen t enum_base_class param_enum_class e in - let run md = - match md with - | TEnumDecl e when is_hxgen md -> - if convert_all then - convert e - else if convert_if_has_meta && has_any_meta e then - convert e - else if not (Meta.has Meta.FlatEnum e.e_meta) then - convert e - else begin - (* take off the :hxgen meta from it, if there's any *) - e.e_meta <- List.filter (fun (n,_,_) -> not (n = Meta.HxGen)) e.e_meta; - md - end - | _ -> - md - in - gen.gmodule_filters#add name (PCustom priority) run -end;; - -(* ******************************************* *) -(* EnumToClassExprf *) -(* ******************************************* *) -(* - Enum to class Expression Filter - - dependencies: - Should run before TArrayTransform, since it generates array access expressions -*) -module EnumToClassExprf = -struct - let name = "enum_to_class_exprf" - let priority = solve_deps name [DBefore TArrayTransform.priority] - - let configure gen t mk_enum_index_call = - let rec run e = - let get_converted_enum_type et = - let en, eparams = match follow (gen.gfollow#run_f et) with - | TEnum(en,p) -> en, p - | _ -> raise Not_found - in - let cl = Hashtbl.find t.ec_tbl en.e_path in - TInst(cl, eparams) - in - - match e.eexpr with - | TEnumIndex f -> - let f = run f in - (try - mk_field_access gen {f with etype = get_converted_enum_type f.etype} "index" e.epos - with Not_found -> - mk_enum_index_call f e.epos) - | TCall (({eexpr = TField(_, FStatic({cl_path=[],"Type"},{cf_name="enumIndex"}))} as left), [f]) -> - let f = run f in - (try - mk_field_access gen {f with etype = get_converted_enum_type f.etype} "index" e.epos - with Not_found -> - { e with eexpr = TCall(left, [f]) }) - | TEnumParameter(f, _,i) -> - let f = run f in - (* check if en was converted to class *) - (* if it was, switch on tag field and change cond type *) - let f = try - { f with etype = get_converted_enum_type f.etype } - with Not_found -> - f - in - let cond_array = { (mk_field_access gen f "params" f.epos) with etype = gen.gclasses.nativearray t_dynamic } in - index gen.gcon.basic cond_array i e.etype e.epos - | _ -> - Type.map_expr run e - in - gen.gexpr_filters#add name (PCustom priority) run - -end;; - -let configure gen convert_all convert_if_has_meta enum_base_class param_enum_class mk_enum_index_call = - let t = new_t () in - EnumToClassModf.configure gen t convert_all convert_if_has_meta enum_base_class param_enum_class; - EnumToClassExprf.configure gen t mk_enum_index_call diff --git a/src/codegen/gencommon/enumToClass2.ml b/src/codegen/gencommon/enumToClass2.ml deleted file mode 100644 index 09f6f6cb1f9..00000000000 --- a/src/codegen/gencommon/enumToClass2.ml +++ /dev/null @@ -1,398 +0,0 @@ -(* - The Haxe Compiler - Copyright (C) 2005-2019 Haxe Foundation - - This program is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License - as published by the Free Software Foundation; either version 2 - of the License, or (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. -*) -open Common -open Ast -open Texpr.Builder -open Type -open Gencommon - -let add_static c cf = - c.cl_statics <- PMap.add cf.cf_name cf c.cl_statics; - c.cl_ordered_statics <- cf :: c.cl_ordered_statics - -let add_field c cf override = - c.cl_fields <- PMap.add cf.cf_name cf c.cl_fields; - c.cl_ordered_fields <- cf :: c.cl_ordered_fields; - if override then add_class_field_flag cf CfOverride - -let add_meta com en cl_enum = - Option.may (fun expr -> - let cf_meta = mk_field ~static:true "__meta__" expr.etype expr.epos expr.epos in - cf_meta.cf_expr <- Some expr; - add_static cl_enum cf_meta; - ) (Texpr.build_metadata com.basic (TEnumDecl en)); - -type enclasses = { - base : tclass; - ctors : (string, tclass) PMap.t; -} - -module EnumToClass2Modf = struct - let name = "enum_to_class2_mod" - let priority = solve_deps name [DBefore ReflectionCFs.priority; DBefore RealTypeParams.RealTypeParamsModf.priority] - - let convert gen ec_tbl base_class en = - let pos = en.e_pos in - - (* create the class *) - let cl_enum = mk_class en.e_module en.e_path pos in - cl_enum.cl_super <- Some (base_class,[]); - if en.e_extern then add_class_flag cl_enum CExtern; - cl_enum.cl_meta <- [(Meta.Enum,[],pos); (Meta.NativeGen,[],pos)] @ cl_enum.cl_meta; - - (* mark the enum that it's generated as a class *) - en.e_meta <- (Meta.Class,[],pos) :: en.e_meta; - - (* add metadata *) - add_meta gen.gcon en cl_enum; - - let basic = gen.gcon.basic in - let mk_array_decl t el p = mk_nativearray_decl gen t el p in - - (* add constructs field (for reflection) *) - if has_feature gen.gcon "Type.getEnumConstructs" then begin - let e_constructs = mk_array_decl basic.tstring (List.map (fun s -> make_string gen.gcon.basic s pos) en.e_names) pos in - let cf_constructs = mk_field ~static:true "__hx_constructs" e_constructs.etype pos pos in - cf_constructs.cf_kind <- Var { v_read = AccNormal; v_write = AccNever }; - cf_constructs.cf_meta <- (Meta.ReadOnly,[],pos) :: (Meta.Protected,[],pos) :: cf_constructs.cf_meta; - cf_constructs.cf_expr <- Some e_constructs; - add_static cl_enum cf_constructs - end; - - (* add the class to the module *) - gen.gadd_to_module (TClassDecl cl_enum) max_dep; - - let eparamsToString = mk_static_field_access_infer base_class "paramsToString" pos [] in - let eparamsGetHashCode = mk_static_field_access_infer base_class "paramsGetHashCode" pos [] in - - let e_pack, e_name = en.e_path in - let cl_enum_t = TInst (cl_enum, []) in - let cf_getTag_t = tfun [] basic.tstring in - let cf_getParams_ret = basic.tarray (mk_anon (ref Closed)) in - let cf_getParams_t = tfun [] cf_getParams_ret in - let static_ctors = ref [] in - let ctors_map = ref PMap.empty in - let add_ctor name index = - let ef = PMap.find name en.e_constrs in - let pos = ef.ef_pos in - - let cl_ctor = mk_class en.e_module (e_pack, e_name ^ "_" ^ name) pos in - add_class_flag cl_ctor CFinal; - cl_ctor.cl_super <- Some (cl_enum, []); - cl_ctor.cl_meta <- [ - (Meta.Enum,[],pos); - (Meta.NativeGen,[],pos); - ] @ cl_ctor.cl_meta; - ctors_map := PMap.add name cl_ctor !ctors_map; - - gen.gadd_to_module (TClassDecl cl_ctor) max_dep; - - let esuper = mk (TConst TSuper) cl_enum_t pos in - let etag = make_string gen.gcon.basic name pos in - let efields = ref [] in - (match follow ef.ef_type with - | TFun(_, _) -> - (* erase type params *) - let ef_type = - let t = apply_params en.e_params (List.map (fun _ -> t_dynamic) en.e_params) ef.ef_type in - apply_params ef.ef_params (List.map (fun _ -> t_dynamic) ef.ef_params) t - in - let params, ret = get_fun ef_type in - - let cl_ctor_t = TInst (cl_ctor,[]) in - let other_en_v = alloc_var "en" cl_ctor_t in - let other_en_local = mk_local other_en_v pos in - let enumeq = mk_static_field_access_infer (get_cl (get_type gen ([],"Type"))) "enumEq" pos [t_dynamic] in - let refeq = mk_static_field_access_infer (get_cl (get_type gen (["System"],"Object"))) "ReferenceEquals" pos [] in - - let param_equal_checks = ref [] in - let ctor_block = ref [] in - let ctor_args = ref [] in - let static_ctor_args = ref [] in - let ethis = mk (TConst TThis) cl_ctor_t pos in - List.iter (fun (n,_,t) -> - (* create a field for enum argument *) - let cf_param = mk_field n t pos pos in - cf_param.cf_kind <- Var { v_read = AccNormal; v_write = AccNever }; - cf_param.cf_meta <- (Meta.ReadOnly,[],pos) :: cf_param.cf_meta; - add_field cl_ctor cf_param false; - - (* add static constructor method argument *) - static_ctor_args := (alloc_var n t, None) :: !static_ctor_args; - - (* generate argument field access *) - let efield = mk (TField (ethis, FInstance (cl_ctor, [], cf_param))) t pos in - efields := efield :: !efields; - - (* add constructor argument *) - let ctor_arg_v = alloc_var n t in - ctor_args := (ctor_arg_v, None) :: !ctor_args; - - (* generate assignment for the constructor *) - let assign = binop OpAssign efield (mk_local ctor_arg_v pos) t pos in - ctor_block := assign :: !ctor_block; - - (* generate an enumEq check for the Equals method (TODO: extract this) *) - let eotherfield = mk (TField (other_en_local, FInstance (cl_ctor, [], cf_param))) t pos in - let e_enumeq_check = mk (TCall (enumeq, [efield; eotherfield])) basic.tbool pos in - let e_param_check = - mk (TIf (mk (TUnop (Not, Prefix, e_enumeq_check)) basic.tbool pos, - mk_return (make_bool gen.gcon.basic false pos), - None) - ) basic.tvoid pos in - param_equal_checks := e_param_check :: !param_equal_checks; - ) (List.rev params); - - ctor_block := (mk (TCall(esuper,[make_int gen.gcon.basic index pos])) basic.tvoid pos) :: !ctor_block; - - let cf_ctor_t = TFun (params, basic.tvoid) in - let cf_ctor = mk_class_field "new" cf_ctor_t true pos (Method MethNormal) [] in - cf_ctor.cf_expr <- Some { - eexpr = TFunction { - tf_args = !ctor_args; - tf_type = basic.tvoid; - tf_expr = mk (TBlock !ctor_block) basic.tvoid pos; - }; - etype = cf_ctor_t; - epos = pos; - }; - cl_ctor.cl_constructor <- Some cf_ctor; - - let cf_toString_t = TFun ([],basic.tstring) in - let cf_toString = mk_class_field "toString" cf_toString_t true pos (Method MethNormal) [] in - - let etoString_args = mk_array_decl t_dynamic !efields pos in - cf_toString.cf_expr <- Some { - eexpr = TFunction { - tf_args = []; - tf_type = basic.tstring; - tf_expr = mk_block (mk_return ( - mk (TCall (eparamsToString, [etag; etoString_args])) basic.tstring pos - )); - }; - etype = cf_toString_t; - epos = pos; - }; - add_field cl_ctor cf_toString true; - - let cf_static_ctor = mk_class_field ~static:true name ef_type true pos (Method MethNormal) [] in - cf_static_ctor.cf_expr <- Some { - eexpr = TFunction { - tf_args = !static_ctor_args; - tf_type = ef_type; - tf_expr = mk_block (mk_return {eexpr = TNew(cl_ctor,[], (List.map (fun (v,_) -> mk_local v pos) !static_ctor_args)); etype = ef_type; epos = pos}); - }; - etype = ef_type; - epos = pos; - }; - static_ctors := cf_static_ctor :: !static_ctors; - - (* add Equals field *) - begin - let other_v = alloc_var "other" t_dynamic in - let eother_local = mk_local other_v pos in - let eas = mk (TIdent "__as__") t_dynamic pos in - let ecast = mk (TCall(eas,[eother_local])) cl_ctor_t pos in - - let equals_exprs = ref (List.rev [ - mk (TIf ( - mk (TCall(refeq,[ethis;eother_local])) basic.tbool pos, - mk_return (make_bool gen.gcon.basic true pos), - None - )) basic.tvoid pos; - mk (TVar(other_en_v, Some ecast)) basic.tvoid pos; - mk (TIf( - mk (TBinop(OpEq,other_en_local,make_null cl_ctor_t pos)) basic.tbool pos, - mk_return (make_bool gen.gcon.basic false pos), - None - )) basic.tvoid pos; - ]) in - equals_exprs := (List.rev !param_equal_checks) @ !equals_exprs; - equals_exprs := mk_return (make_bool gen.gcon.basic true pos) :: !equals_exprs; - - let cf_Equals_t = TFun([("other",false,t_dynamic)],basic.tbool) in - let cf_Equals = mk_class_field "Equals" cf_Equals_t true pos (Method MethNormal) [] in - cf_Equals.cf_expr <- Some { - eexpr = TFunction { - tf_args = [(other_v,None)]; - tf_type = basic.tbool; - tf_expr = mk (TBlock (List.rev !equals_exprs)) basic.tvoid pos; - }; - etype = cf_Equals_t; - epos = pos; - }; - add_field cl_ctor cf_Equals true; - end; - - (* add GetHashCode field *) - begin - let cf_GetHashCode_t = TFun([],basic.tint) in - let cf_GetHashCode = mk_class_field "GetHashCode" cf_GetHashCode_t true pos (Method MethNormal) [] in - cf_GetHashCode.cf_expr <- Some { - eexpr = TFunction { - tf_args = []; - tf_type = basic.tint; - tf_expr = mk_block (mk_return ( - mk (TCall(eparamsGetHashCode, [make_int gen.gcon.basic index pos;etoString_args])) basic.tint pos - )); - }; - etype = cf_GetHashCode_t; - epos = pos; - }; - add_field cl_ctor cf_GetHashCode true; - end - - | _ -> - let cf_ctor_t = TFun([], basic.tvoid) in - let cf_ctor = mk_class_field "new" cf_ctor_t true pos (Method MethNormal) [] in - cf_ctor.cf_expr <- Some { - eexpr = TFunction { - tf_args = []; - tf_type = basic.tvoid; - tf_expr = mk (TBlock [mk (TCall(esuper,[make_int gen.gcon.basic index pos])) basic.tvoid pos]) basic.tvoid pos; - }; - etype = cf_ctor_t; - epos = pos; - }; - cl_ctor.cl_constructor <- Some cf_ctor; - - let cf_static_inst = mk_class_field ~static:true name cl_enum_t true pos (Var { v_read = AccNormal; v_write = AccNever }) [] in - cf_static_inst.cf_meta <- [Meta.ReadOnly,[],pos]; - cf_static_inst.cf_expr <- Some { - eexpr = TNew(cl_ctor, [], []); - etype = cl_enum_t; - epos = pos; - }; - - static_ctors := cf_static_inst :: !static_ctors; - ); - - let cf_getTag = mk_class_field "getTag" cf_getTag_t true pos (Method MethNormal) [] in - cf_getTag.cf_expr <- Some { - eexpr = TFunction { - tf_args = []; - tf_type = basic.tstring; - tf_expr = mk_block (mk_return etag); - }; - etype = cf_getTag_t; - epos = pos; - }; - add_field cl_ctor cf_getTag true; - - if !efields <> [] then begin - let cf_getParams = mk_class_field "getParams" cf_getParams_t true pos (Method MethNormal) [] in - cf_getParams.cf_expr <- Some { - eexpr = TFunction { - tf_args = []; - tf_type = cf_getParams_ret; - tf_expr = mk_block (mk_return (mk (TArrayDecl !efields) cf_getParams_ret pos)); - }; - etype = cf_getParams_t; - epos = pos; - }; - add_field cl_ctor cf_getParams true - end - in - - - (* generate constructor subclasses and add static functions to create them *) - let i = ref 0 in - List.iter (fun name -> add_ctor name !i; incr i) en.e_names; - - List.iter (add_static cl_enum) !static_ctors; - - Hashtbl.add ec_tbl en.e_path { - base = cl_enum; - ctors = !ctors_map; - }; - - TEnumDecl en - - let configure gen t enum_base_class = - let run md = match md with - | TEnumDecl e when is_hxgen md -> - convert gen t enum_base_class e - | _ -> - md - in - gen.gmodule_filters#add name (PCustom priority) run -end;; - - -module EnumToClass2Exprf = struct - let init com ec_tbl mk_enum_index_call = - let rec run e = - let get_converted_enum_classes et = - let en = match follow et with - | TEnum (en,_) -> en - | _ -> raise Not_found - in - Hashtbl.find ec_tbl en.e_path - in - let mk_converted_enum_index_access f = - let cl = (get_converted_enum_classes f.etype).base in - let e_enum = { f with etype = TInst (cl, []) } in - field e_enum "_hx_index" com.basic.tint e.epos - in - match e.eexpr with - | TEnumIndex f -> - let f = run f in - (try - mk_converted_enum_index_access f - with Not_found -> - mk_enum_index_call f e.epos) - | TCall ({ eexpr = TField (_, FStatic ({ cl_path = ([], "Type") }, { cf_name = "enumIndex" })) } as left, [f]) -> - let f = run f in - (try - mk_converted_enum_index_access f - with Not_found -> - { e with eexpr = TCall(left, [f]) }) - | TEnumParameter(f, ef, i) -> - let f = run f in - (* check if en was converted to class *) - (* if it was, switch on tag field and change cond type *) - let classes = get_converted_enum_classes f.etype in - let cl_enum = classes.base in - let f = { f with etype = TInst(cl_enum, []) } in - - let cl_ctor = PMap.find ef.ef_name classes.ctors in - let ecast = mk (TCall (mk (TIdent "__as__") t_dynamic f.epos, [f])) (TInst (cl_ctor, [])) f.epos in - - (match ef.ef_type with - | TFun (params, _) -> - let fname, _, _ = List.nth params i in - field ecast fname e.etype e.epos - | _ -> Globals.die "" __LOC__) - | _ -> - Type.map_expr run e - in - run - - let name = "enum_to_class2_exprf" - let priority = solve_deps name [] - - let configure gen ec_tbl mk_enum_index_call = - let run = init gen.gcon ec_tbl mk_enum_index_call in - gen.gexpr_filters#add name (PCustom priority) run -end;; - -let configure gen enum_base_class mk_enum_index_call = - let ec_tbl = Hashtbl.create 10 in - EnumToClass2Modf.configure gen ec_tbl enum_base_class; - EnumToClass2Exprf.configure gen ec_tbl mk_enum_index_call; diff --git a/src/codegen/gencommon/expressionUnwrap.ml b/src/codegen/gencommon/expressionUnwrap.ml deleted file mode 100644 index 7c115d205cb..00000000000 --- a/src/codegen/gencommon/expressionUnwrap.ml +++ /dev/null @@ -1,650 +0,0 @@ -(* - The Haxe Compiler - Copyright (C) 2005-2019 Haxe Foundation - - This program is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License - as published by the Free Software Foundation; either version 2 - of the License, or (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. -*) -open Common -open Ast -open Type -open Gencommon - -(* - This is the most important module for source-code based targets. It will follow a convention of what's an expression and what's a statement, - and will unwrap statements where expressions are expected, and vice-versa. - - It should be one of the first syntax filters to be applied. As a consequence, it's applied after all filters that add code to the AST, and by being - the first of the syntax filters, it will also have the AST retain most of the meaning of normal Haxe code. So it's easier to detect cases which are - side-effects free, for example - - Any target can make use of this, but there is one requirement: The target must accept null to be set to any kind of variable. For example, - var i:Int = null; must be accepted. The best way to deal with this is to (like it's done in C#) make null equal to "default(Type)" - - dependencies: - While it's best for Expression Unwrap to delay its execution as much as possible, since theoretically any - filter can return an expression that needs to be unwrapped, it is also desirable for ExpresionUnwrap to have - the AST as close as possible as Haxe's, so it can make some correct predictions (for example, so it can - more accurately know what can be side-effects-free and what can't). - This way, it will run slightly after the Normal priority, so if you don't say that a syntax filter must run - before Expression Unwrap, it will run after it. - - TODO : While statement must become do / while, with the actual block inside an if for the condition, and else for 'break' -*) - -(* priority: first syntax filter *) -let priority = -10.0 - -(* - We always need to rely on Blocks to be able to unwrap expressions correctly. - So the the standard traverse will always be based on blocks. - Normal block statements, like for(), while(), if(), ... will be mk_block'ed so there is always a block inside of them. - - At the block level, we'll define an "add_statement" function, which will allow the current expression to - add statements to the block. This statement may or may not contain statements as expressions, so the texpr will be evaluated recursively before being added. - - - traverse will always evaluate TBlocks - - for each texpr in a TBlock list, - check shallow type - if type is Statement or Both when it has problematic expression (var problematic_expr = count_problematic_expressions), - if we can eagerly call unwrap_statement on the whole expression (try_call_unwrap_statement), use the return expression - else - check expr_type of each underlying type (with expr_stat_map) - if it has ExprWithStatement or Statement, - call problematic_expression_unwrap in it - problematic_expr-- - else if problematic_expr == 0, just add the unchanged expression - else if NoSideEffects and doesn't have short-circuit, just add the unchanged expression - else call problematic_expression_unwrap in it - if type is Expression, check if there are statements or Both inside. - if there are, problematic_expression_unwrap in it - aftewards, use on_expr_as_statement to get it - - helpers: - try_call_unwrap_statement: (returns texpr option) - if underlying statement is TBinop(OpAssign/OpAssignOp), or TVar, with the right side being a Statement or a short circuit op, we can call apply_assign. - - apply_assign: - if is TVar, first declare the tvar with default expression = null; - will receive the left and right side of the assignment; right-side must be Statement - see if right side is a short-circuit operation, call short_circuit_op_unwrap - else see eexpr of the right side - if it's void, just add the statement with add_statement, and set the right side as null; - if not, it will have a block inside. set the left side = to the last expression on each block inside. add_statement for it. - - short_circuit_op_unwrap: x() && (1 + {var x = 0; x + 1;} == 2) && z() - -> var x = x(); - var y = false; - var z = false; - if (x) //for &&, neg for || - { - var temp = null; - { - var x = 0; - temp = x + 1; - } - - y = (1 + temp) == 2; - if (y) - { - z = z(); - } - } - expects to receive a texpr with TBinop(OpBoolAnd/OpBoolOr) - will traverse the AST while there is a TBinop(OpBoolAnd/OpBoolOr) as a right-side expr, and declare new temp vars in the for each found. - will collect the return value, a mapped expr with all exprs as TLocal of the temp vars created - - - problematic_expression_unwrap: - check expr_kind: - if it is NoSideEffects and not short-circuit, leave it there - if it is ExprWithStatement and not short-circuit, call Type.map_expr problematic_expression_unwrap - if it is Statement or Expression or short-circuit expr, call add_assign for this expression - - add_assign: - see if the type is void. If it is, just add_statement the expression argument, and return a null value - else create a new variable, set TVar with Some() with the expression argument, add TVar with add_statement, and return the TLocal of this expression. - - map_problematic_expr: - call expr_stat_map on statement with problematic_expression_unwrap - - types: - type shallow_expr_type = | Statement | Expression | Both (* shallow expression classification. Both means that they can be either Statements as Expressions *) - - type expr_kind = | NormalExpr | ExprNoSideEffects (* -> short-circuit is considered side-effects *) | ExprWithStatement | Statement - evaluates an expression (as in not a statement) type. If it is ExprWithStatement or Statement, it means it contains errors - - functions: - shallow_expr_type (expr:texpr) : shallow_expr_type - - expr_kind (expr:texpr) : expr_kind - deeply evaluates an expression type - - expr_stat_map (fn:texpr->texpr) (expr:texpr) : texpr - it will traverse the AST looking for places where an expression is expected, and map the value according to fn - - aggregate_expr_type (is_side_effects_free:bool) (children:expr_type list) : expr_type - helper function to deal with expr_type aggregation (e.g. an Expression + a Statement as a children, is a ExprWithStatement) - - check_statement_in_expression (expr:texpr) : texpr option : - will check - -*) - -type shallow_expr_type = | Statement | Expression of texpr | Both of texpr (* shallow expression classification. Both means that they can be either Statements as Expressions *) - -type expr_kind = | KNormalExpr | KNoSideEffects (* -> short-circuit is considered side-effects *) | KExprWithStatement | KStatement - -let rec no_paren e = - match e.eexpr with - | TParenthesis e -> no_paren e - | _ -> e - -(* must be called in a statement. Will execute fn whenever an expression (not statement) is expected *) -let rec expr_stat_map fn (expr:texpr) = - match (no_paren expr).eexpr with - | TBinop ( (OpAssign as op), left_e, right_e ) - | TBinop ( (OpAssignOp _ as op), left_e, right_e ) -> - { expr with eexpr = TBinop(op, fn left_e, fn right_e) } - | TParenthesis _ -> Globals.die "" __LOC__ - | TCall(left_e, params) -> - { expr with eexpr = TCall(fn left_e, List.map fn params) } - | TNew(cl, tparams, params) -> - { expr with eexpr = TNew(cl, tparams, List.map fn params) } - | TVar(v,eopt) -> - { expr with eexpr = TVar(v, Option.map fn eopt) } - | TFor (v,cond,block) -> - { expr with eexpr = TFor(v, fn cond, block) } - | TIf(cond,eif,eelse) -> - { expr with eexpr = TIf(fn cond, eif, eelse) } - | TWhile(cond, block, flag) -> - { expr with eexpr = TWhile(fn cond, block, flag) } - | TSwitch switch -> - let switch = { switch with - switch_subject = fn switch.switch_subject; - switch_cases = List.map (fun case -> {case with case_patterns = List.map fn case.case_patterns}) switch.switch_cases; - } in - { expr with eexpr = TSwitch switch } - | TReturn(eopt) -> - { expr with eexpr = TReturn(Option.map fn eopt) } - | TThrow (texpr) -> - { expr with eexpr = TThrow(fn texpr) } - | TBreak - | TContinue - | TTry _ - | TUnop (Increment, _, _) - | TUnop (Decrement, _, _) (* unop is a special case because the haxe compiler won't let us generate complex expressions with Increment/Decrement *) - | TBlock _ -> expr (* there is no expected expression here. Only statements *) - | TMeta(m,e) -> - { expr with eexpr = TMeta(m,expr_stat_map fn e) } - | _ -> Globals.die "" __LOC__ (* we only expect valid statements here. other expressions aren't valid statements *) - -let is_expr = function | Expression _ -> true | _ -> false - -let aggregate_expr_type map_fn side_effects_free children = - let rec loop acc children = - match children with - | [] -> acc - | hd :: children -> - match acc, map_fn hd with - | _, KExprWithStatement - | _, KStatement - | KExprWithStatement, _ - | KStatement, _ -> KExprWithStatement - | KNormalExpr, KNoSideEffects - | KNoSideEffects, KNormalExpr - | KNormalExpr, KNormalExpr -> loop KNormalExpr children - | KNoSideEffects, KNoSideEffects -> loop KNoSideEffects children - in - loop (if side_effects_free then KNoSideEffects else KNormalExpr) children - -(* statements: *) -(* Error CS0201: Only assignment, call, increment, *) -(* decrement, and new object expressions can be used as a *) -(* statement (CS0201). *) -let rec shallow_expr_type expr : shallow_expr_type = - match expr.eexpr with - | TCall _ when not (ExtType.is_void expr.etype) -> Both expr - | TNew _ - | TUnop (Increment, _, _) - | TUnop (Decrement, _, _) - | TBinop (OpAssign, _, _) - | TBinop (OpAssignOp _, _, _) -> Both expr - | TIf (cond, eif, Some(eelse)) -> (match aggregate_expr_type expr_kind true [cond;eif;eelse] with - | KExprWithStatement -> Statement - | _ -> Both expr) - | TConst _ - | TLocal _ - | TIdent _ - | TArray _ - | TBinop _ - | TField _ - | TEnumParameter _ - | TEnumIndex _ - | TTypeExpr _ - | TObjectDecl _ - | TArrayDecl _ - | TFunction _ - | TCast _ - | TUnop _ -> Expression (expr) - | TParenthesis p | TMeta(_,p) -> shallow_expr_type p - | TBlock ([e]) -> shallow_expr_type e - | TCall _ - | TVar _ - | TBlock _ - | TFor _ - | TWhile _ - | TSwitch _ - | TTry _ - | TReturn _ - | TBreak - | TContinue - | TIf _ - | TThrow _ -> Statement - -and expr_kind expr = - match shallow_expr_type expr with - | Statement -> KStatement - | Both expr | Expression expr -> - let aggregate = aggregate_expr_type expr_kind in - match expr.eexpr with - | TConst _ - | TLocal _ - | TFunction _ - | TTypeExpr _ - | TIdent _ -> - KNoSideEffects - | TCall (ecall, params) -> - aggregate false (ecall :: params) - | TNew (_,_,params) -> - aggregate false params - | TUnop (Increment,_,e) - | TUnop (Decrement,_,e) -> - aggregate false [e] - | TUnop (_,_,e) -> - aggregate true [e] - | TBinop (OpBoolAnd, e1, e2) - | TBinop (OpBoolOr, e1, e2) -> (* TODO: should OpBool never be side-effects free? *) - aggregate true [e1;e2] - | TBinop (OpAssign, e1, e2) - | TBinop (OpAssignOp _, e1, e2) -> - aggregate false [e1;e2] - | TBinop (_, e1, e2) -> - aggregate true [e1;e2] - | TIf (cond, eif, Some(eelse)) -> (match aggregate true [cond;eif;eelse] with - | KExprWithStatement -> KStatement - | k -> k) - | TArray (e1,e2) -> - aggregate true [e1;e2] - | TParenthesis e - | TMeta(_,e) - | TField (e,_) -> - aggregate true [e] - | TArrayDecl (el) -> - aggregate true el - | TObjectDecl (sel) -> - aggregate true (List.map snd sel) - | TCast (e,_) -> - aggregate false [e] - | _ -> trace (debug_expr expr); Globals.die "" __LOC__ (* should have been read as Statement by shallow_expr_type *) - -let get_kinds (statement:texpr) = - let kinds = ref [] in - ignore (expr_stat_map (fun e -> - kinds := (expr_kind e) :: !kinds; - e - ) statement); - List.rev !kinds - -let has_problematic_expressions (kinds:expr_kind list) = - let rec loop kinds = - match kinds with - | [] -> false - | KStatement :: _ - | KExprWithStatement :: _ -> true - | _ :: tl -> loop tl - in - loop kinds - -let count_problematic_expressions (statement:texpr) = - let count = ref 0 in - ignore (expr_stat_map (fun e -> - (match expr_kind e with - | KStatement | KExprWithStatement -> incr count - | _ -> () - ); - e - ) statement); - !count - -let apply_assign_block assign_fun elist = - let rec assign acc elist = - match elist with - | [] -> acc - | last :: [] -> - (assign_fun last) :: acc - | hd :: tl -> - assign (hd :: acc) tl - in - List.rev (assign [] elist) - -let mk_get_block assign_fun e = - match e.eexpr with - | TBlock [] -> e - | TBlock (el) -> - { e with eexpr = TBlock(apply_assign_block assign_fun el) } - | _ -> - { e with eexpr = TBlock([ assign_fun e ]) } - -let add_assign add_statement expr = - match expr.eexpr, follow expr.etype with - | _, TAbstract ({ a_path = ([],"Void") },[]) - | TThrow _, _ -> - add_statement expr; - null expr.etype expr.epos - | _ -> - let var = mk_temp "stmt" expr.etype in - let tvars = { expr with eexpr = TVar(var,Some(expr)) } in - let local = { expr with eexpr = TLocal(var) } in - add_statement tvars; - local - -(* requirement: right must be a statement *) -let rec apply_assign assign_fun right = - match right.eexpr with - | TBlock el -> - { right with eexpr = TBlock(apply_assign_block assign_fun el) } - | TSwitch switch -> - let switch = { switch with - switch_cases = List.map (fun case -> {case with case_expr = mk_get_block assign_fun case.case_expr}) switch.switch_cases; - switch_default = Option.map (mk_get_block assign_fun) switch.switch_default; - } in - { right with eexpr = TSwitch switch } - | TTry (block, catches) -> - { right with eexpr = TTry(mk_get_block assign_fun block, List.map (fun (v,block) -> (v,mk_get_block assign_fun block) ) catches) } - | TIf (cond,eif,eelse) -> - { right with eexpr = TIf(cond, mk_get_block assign_fun eif, Option.map (mk_get_block assign_fun) eelse) } - | TThrow _ - | TWhile _ - | TFor _ - | TReturn _ - | TBreak - | TContinue -> right - | TParenthesis p | TMeta(_,p) -> - apply_assign assign_fun p - | TVar _ -> - right - | _ -> - match follow right.etype with - | TAbstract ({ a_path = ([], "Void") },[]) -> - right - | _ -> trace (debug_expr right); Globals.die "" __LOC__ (* a statement is required *) - -let short_circuit_op_unwrap com add_statement expr :texpr = - let do_not expr = - { expr with eexpr = TUnop(Not, Prefix, expr) } - in - - (* loop will always return its own TBlock, and the mapped expression *) - let rec loop acc expr = - match expr.eexpr with - | TBinop ( (OpBoolAnd as op), left, right) -> - let var = mk_temp "boolv" right.etype in - let tvars = { right with eexpr = TVar(var, Some( { right with eexpr = TConst(TBool false); etype = com.basic.tbool } )); etype = com.basic.tvoid } in - let local = { right with eexpr = TLocal(var) } in - - let mapped_left, ret_acc = loop ( (local, { right with eexpr = TBinop(OpAssign, local, right) } ) :: acc) left in - - add_statement tvars; - ({ expr with eexpr = TBinop(op, mapped_left, local) }, ret_acc) - (* we only accept OpBoolOr when it's the first to be evaluated *) - | TBinop ( (OpBoolOr as op), left, right) when acc = [] -> - let left = match left.eexpr with - | TLocal _ | TConst _ -> left - | _ -> add_assign add_statement left - in - - let var = mk_temp "boolv" right.etype in - let tvars = { right with eexpr = TVar(var, Some( { right with eexpr = TConst(TBool false); etype = com.basic.tbool } )); etype = com.basic.tvoid } in - let local = { right with eexpr = TLocal(var) } in - add_statement tvars; - - ({ expr with eexpr = TBinop(op, left, local) }, [ do_not left, { right with eexpr = TBinop(OpAssign, local, right) } ]) - | _ when acc = [] -> Globals.die "" __LOC__ - | _ -> - let var = mk_temp "boolv" expr.etype in - let tvars = { expr with eexpr = TVar(var, Some( { expr with etype = com.basic.tbool } )); etype = com.basic.tvoid } in - let local = { expr with eexpr = TLocal(var) } in - - let last_local = ref local in - let acc = List.map (fun (local, assign) -> - let l = !last_local in - last_local := local; - (l, assign) - ) acc in - - add_statement tvars; - (local, acc) - in - - let mapped_expr, local_assign_list = loop [] expr in - - let rec loop local_assign_list : texpr = - match local_assign_list with - | [local, assign] -> - { eexpr = TIf(local, assign, None); etype = com.basic.tvoid; epos = assign.epos } - | (local, assign) :: tl -> - { eexpr = TIf(local, - { - eexpr = TBlock ( assign :: [loop tl] ); - etype = com.basic.tvoid; - epos = assign.epos; - }, - None); etype = com.basic.tvoid; epos = assign.epos } - | [] -> Globals.die "" __LOC__ - in - - add_statement (loop local_assign_list); - mapped_expr - -let twhile_with_condition_statement com add_statement twhile cond e1 flag = - (* when a TWhile is found with a problematic condition *) - let block = - if flag = NormalWhile then - { e1 with eexpr = TIf(cond, e1, Some({ e1 with eexpr = TBreak; etype = com.basic.tvoid })) } - else - Type.concat e1 { e1 with - eexpr = TIf({ - eexpr = TUnop(Not, Prefix, mk_paren cond); - etype = com.basic.tbool; - epos = cond.epos - }, { e1 with eexpr = TBreak; etype = com.basic.tvoid }, None); - etype = com.basic.tvoid - } - in - add_statement { twhile with - eexpr = TWhile( - { eexpr = TConst(TBool true); etype = com.basic.tbool; epos = cond.epos }, - block, - DoWhile - ); - } - -let try_call_unwrap_statement com handle_cast problematic_expression_unwrap (add_statement:texpr->unit) (expr:texpr) : texpr option = - let check_left left = - match expr_kind left with - | KExprWithStatement -> - problematic_expression_unwrap add_statement left KExprWithStatement - | KStatement -> Globals.die "" __LOC__ (* doesn't make sense a KStatement as a left side expression *) - | _ -> left - in - - let handle_assign op left right = - let left = check_left left in - Some (apply_assign (fun e -> { e with eexpr = TBinop(op, left, if ExtType.is_void left.etype then e else handle_cast left.etype e.etype e) }) right ) - in - - let handle_return e = - Some( apply_assign (fun e -> - match e.eexpr with - | TThrow _ -> e - | _ when ExtType.is_void e.etype -> - { e with eexpr = TBlock([e; { e with eexpr = TReturn None }]) } - | _ -> - Texpr.Builder.mk_return e - ) e ) - in - - let is_problematic_if right = - match expr_kind right with - | KStatement | KExprWithStatement -> true - | _ -> false - in - - match expr.eexpr with - | TBinop((OpAssign as op),left,right) - | TBinop((OpAssignOp _ as op),left,right) when shallow_expr_type right = Statement -> - handle_assign op left right - | TReturn( Some right ) when shallow_expr_type right = Statement -> - handle_return right - | TBinop((OpAssign as op),left, ({ eexpr = TBinop(OpBoolAnd,_,_) } as right) ) - | TBinop((OpAssign as op),left,({ eexpr = TBinop(OpBoolOr,_,_) } as right)) - | TBinop((OpAssignOp _ as op),left,({ eexpr = TBinop(OpBoolAnd,_,_) } as right) ) - | TBinop((OpAssignOp _ as op),left,({ eexpr = TBinop(OpBoolOr,_,_) } as right) ) -> - let right = short_circuit_op_unwrap com add_statement right in - Some { expr with eexpr = TBinop(op, check_left left, right) } - | TVar(v,Some({ eexpr = TBinop(OpBoolAnd,_,_) } as right)) - | TVar(v,Some({ eexpr = TBinop(OpBoolOr,_,_) } as right)) -> - let right = short_circuit_op_unwrap com add_statement right in - Some { expr with eexpr = TVar(v, Some(right)) } - | TVar(v,Some(right)) when shallow_expr_type right = Statement -> - add_statement ({ expr with eexpr = TVar(v, Some(null right.etype right.epos)) }); - handle_assign OpAssign { expr with eexpr = TLocal(v); etype = v.v_type } right - (* TIf handling *) - | TBinop((OpAssign as op),left, ({ eexpr = TIf _ } as right)) - | TBinop((OpAssignOp _ as op),left,({ eexpr = TIf _ } as right)) when is_problematic_if right -> - handle_assign op left right - | TVar(v,Some({ eexpr = TIf _ } as right)) when is_problematic_if right -> - add_statement ({ expr with eexpr = TVar(v, Some(null right.etype right.epos)) }); - handle_assign OpAssign { expr with eexpr = TLocal(v); etype = v.v_type } right - | TWhile(cond, e1, flag) when is_problematic_if cond -> - twhile_with_condition_statement com add_statement expr cond e1 flag; - Some (null expr.etype expr.epos) - | _ -> None - -let problematic_expression_unwrap add_statement expr e_type = - let rec problematic_expression_unwrap is_first expr e_type = - match e_type, expr.eexpr with - | _, TBinop(OpBoolAnd, _, _) - | _, TBinop(OpBoolOr, _, _) -> add_assign add_statement expr (* add_assign so try_call_unwrap_expr *) - | KNoSideEffects, _ -> expr - | KStatement, _ - | KNormalExpr, _ -> add_assign add_statement expr - | KExprWithStatement, TCall _ - | KExprWithStatement, TNew _ - | KExprWithStatement, TBinop (OpAssign,_,_) - | KExprWithStatement, TBinop (OpAssignOp _,_,_) - | KExprWithStatement, TUnop (Increment,_,_) (* all of these may have side-effects, so they must also be add_assign'ed . is_first avoids infinite loop *) - | KExprWithStatement, TUnop (Decrement,_,_) when not is_first -> add_assign add_statement expr - - (* bugfix: Type.map_expr doesn't guarantee the correct order of execution *) - | KExprWithStatement, TBinop(op,e1,e2) -> - let e1 = problematic_expression_unwrap false e1 (expr_kind e1) in - let e2 = problematic_expression_unwrap false e2 (expr_kind e2) in - { expr with eexpr = TBinop(op, e1, e2) } - | KExprWithStatement, TArray(e1,e2) -> - let e1 = problematic_expression_unwrap false e1 (expr_kind e1) in - let e2 = problematic_expression_unwrap false e2 (expr_kind e2) in - { expr with eexpr = TArray(e1, e2) } - (* bugfix: calls should not be transformed into closure calls *) - | KExprWithStatement, TCall(( { eexpr = TField (ef_left, f) } as ef ), eargs) -> - { expr with eexpr = TCall( - { ef with eexpr = TField(problematic_expression_unwrap false ef_left (expr_kind ef_left), f) }, - List.map (fun e -> problematic_expression_unwrap false e (expr_kind e)) eargs) - } - | KExprWithStatement, _ -> Type.map_expr (fun e -> problematic_expression_unwrap false e (expr_kind e)) expr - in - problematic_expression_unwrap true expr e_type - -let configure gen = - let rec traverse e = - match e.eexpr with - | TBlock el -> - let new_block = ref [] in - let rec process_statement e = - let e = no_paren e in - match e.eexpr, shallow_expr_type e with - | TCall( { eexpr = TIdent s } as elocal, elist ), _ when String.get s 0 = '_' && Hashtbl.mem gen.gspecial_vars s -> - new_block := { e with eexpr = TCall( elocal, List.map (fun e -> - match e.eexpr with - | TBlock _ -> traverse e - | _ -> e - ) elist ) } :: !new_block - | _, Statement | _, Both _ -> - let e = match e.eexpr with TReturn (Some ({ eexpr = TThrow _ } as ethrow)) -> ethrow | _ -> e in - let kinds = get_kinds e in - if has_problematic_expressions kinds then begin - match try_call_unwrap_statement gen.gcon gen.ghandle_cast problematic_expression_unwrap process_statement e with - | Some { eexpr = TConst(TNull) } (* no op *) - | Some { eexpr = TBlock [] } -> () - | Some e -> - if has_problematic_expressions (get_kinds e) then begin - process_statement e - end else - new_block := (traverse e) :: !new_block - | None -> - ( - let acc = ref kinds in - let new_e = expr_stat_map (fun e -> - match !acc with - | hd :: tl -> - acc := tl; - if has_problematic_expressions (hd :: tl) then begin - problematic_expression_unwrap process_statement e hd - end else - e - | [] -> Globals.die "" __LOC__ - ) e in - - new_block := (traverse new_e) :: !new_block - ) - end else begin new_block := (traverse e) :: !new_block end - | _, Expression e -> - let e = mk (TVar (mk_temp "expr" e.etype, Some e)) gen.gcon.basic.tvoid e.epos in - process_statement e - in - List.iter process_statement el; - let block = List.rev !new_block in - { e with eexpr = TBlock block } - | TTry (block, catches) -> - { e with eexpr = TTry(traverse (mk_block block), List.map (fun (v,block) -> (v, traverse (mk_block block))) catches) } - | TSwitch switch -> - let switch = { switch with - switch_cases = List.map (fun case -> {case with case_expr = traverse (mk_block case.case_expr)}) switch.switch_cases; - switch_default = Option.map (fun e -> traverse (mk_block e)) switch.switch_default; - } in - { e with eexpr = TSwitch switch } - | TWhile (cond,block,flag) -> - {e with eexpr = TWhile(cond,traverse (mk_block block), flag) } - | TIf (cond, eif, eelse) -> - { e with eexpr = TIf(cond, traverse (mk_block eif), Option.map (fun e -> traverse (mk_block e)) eelse) } - | TFor (v,it,block) -> - { e with eexpr = TFor(v,it, traverse (mk_block block)) } - | TFunction (tfunc) -> - { e with eexpr = TFunction({ tfunc with tf_expr = traverse (mk_block tfunc.tf_expr) }) } - | TMeta (m, e2) -> - { e with eexpr = TMeta (m, traverse e2)} - | _ -> e (* if expression doesn't have a block, we will exit *) - in - gen.gsyntax_filters#add "expression_unwrap" (PCustom priority) traverse diff --git a/src/codegen/gencommon/filterClosures.ml b/src/codegen/gencommon/filterClosures.ml deleted file mode 100644 index 7a4416790c3..00000000000 --- a/src/codegen/gencommon/filterClosures.ml +++ /dev/null @@ -1,86 +0,0 @@ -(* - The Haxe Compiler - Copyright (C) 2005-2019 Haxe Foundation - - This program is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License - as published by the Free Software Foundation; either version 2 - of the License, or (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. -*) -open Type -open Gencommon - -(* ******************************************* *) -(* Closure Detection *) -(* ******************************************* *) -(* - Just a small utility filter that detects when a closure must be created. - On the default implementation, this means when a function field is being accessed - not via reflection and not to be called instantly - - dependencies: - must run after DynamicFieldAccess, so any TAnon { ClassStatics / EnumStatics } will be changed to the corresponding TTypeExpr -*) -let name = "filter_closures" -let priority = solve_deps name [DAfter DynamicFieldAccess.priority] - -let configure gen (should_change:texpr->string->bool) (filter:texpr->texpr->string->bool->texpr) = - let rec run e = - match e.eexpr with - (*(* this is precisely the only case where we won't even ask if we should change, because it is a direct use of TClosure *) - | TCall ( {eexpr = TClosure(e1,s)} as clos, args ) -> - { e with eexpr = TCall({ clos with eexpr = TClosure(run e1, s) }, List.map run args ) } - | TCall ( clos, args ) -> - let rec loop clos = match clos.eexpr with - | TClosure(e1,s) -> Some (clos, e1, s) - | TParenthesis p -> loop p - | _ -> None - in - let clos = loop clos in - (match clos with - | Some (clos, e1, s) -> { e with eexpr = TCall({ clos with eexpr = TClosure(run e1, s) }, List.map run args ) } - | None -> Type.map_expr run e)*) - | TCall({ eexpr = TIdent "__delegate__" } as local, [del]) -> - { e with eexpr = TCall(local, [Type.map_expr run del]) } - | TCall(({ eexpr = TField(_, _) } as ef), params) -> - { e with eexpr = TCall(Type.map_expr run ef, List.map run params) } - | TField(ef, FEnum(en, field)) -> - (* FIXME replace t_dynamic with actual enum Anon field *) - let ef = run ef in - (match follow field.ef_type with - | TFun _ when should_change ef field.ef_name -> - filter e ef field.ef_name true - | _ -> - { e with eexpr = TField(ef, FEnum(en,field)) } - ) - | TField(({ eexpr = TTypeExpr _ } as tf), f) -> - (match field_access_esp gen tf.etype (f) with - | FClassField(_,_,_,cf,_,_,_) -> - (match cf.cf_kind with - | Method(MethDynamic) - | Var _ -> - e - | _ when should_change tf cf.cf_name -> - filter e tf cf.cf_name true - | _ -> - e - ) - | _ -> e) - | TField(e1, FClosure (Some _, cf)) when should_change e1 cf.cf_name -> - (match cf.cf_kind with - | Method MethDynamic | Var _ -> - Type.map_expr run e - | _ -> - filter e (run e1) cf.cf_name false) - | _ -> Type.map_expr run e - in - gen.gexpr_filters#add name (PCustom priority) run diff --git a/src/codegen/gencommon/fixOverrides.ml b/src/codegen/gencommon/fixOverrides.ml deleted file mode 100644 index dc738df19c0..00000000000 --- a/src/codegen/gencommon/fixOverrides.ml +++ /dev/null @@ -1,275 +0,0 @@ -(* - The Haxe Compiler - Copyright (C) 2005-2019 Haxe Foundation - - This program is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License - as published by the Free Software Foundation; either version 2 - of the License, or (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. -*) -open Option -open Common -open Type -open Gencommon - -(* ******************************************* *) -(* FixOverrides *) -(* ******************************************* *) -(* - - Covariant return types, contravariant function arguments and applied type parameters may change - in a way that expected implementations / overrides aren't recognized as such. - This filter will fix that. - - dependencies: - FixOverrides expects that the target platform is able to deal with overloaded functions - It must run after DefaultArguments, otherwise code added by the default arguments may be invalid - -*) -let name = "fix_overrides" -let priority = solve_deps name [] - -(* - if the platform allows explicit interface implementation (C#), - specify a explicit_fn_name function (tclass->string->string) - Otherwise, it expects the platform to be able to handle covariant return types -*) -let run ~explicit_fn_name ~get_vmtype gen = - let implement_explicitly = is_some explicit_fn_name in - let run md = match md with - | TClassDecl c when (has_class_flag c CInterface) && not (has_class_flag c CExtern) -> - (* overrides can be removed from interfaces *) - c.cl_ordered_fields <- List.filter (fun f -> - try - if has_class_field_flag f CfOverload then raise Not_found; - let f2 = Codegen.find_field gen.gcon c f in - if f2 == f then raise Not_found; - c.cl_fields <- PMap.remove f.cf_name c.cl_fields; - false; - with Not_found -> - true - ) c.cl_ordered_fields; - md - | TClassDecl c when not (has_class_flag c CExtern) -> - let this = { eexpr = TConst TThis; etype = TInst(c,extract_param_types c.cl_params); epos = c.cl_pos } in - (* look through all interfaces, and try to find a type that applies exactly *) - let rec loop_iface (iface:tclass) itl = - List.iter (fun (s,stl) -> loop_iface s (List.map (apply_params iface.cl_params itl) stl)) iface.cl_implements; - let real_itl = gen.greal_type_param (TClassDecl iface) itl in - let rec loop_f f = - List.iter loop_f f.cf_overloads; - let ftype = apply_params iface.cl_params itl f.cf_type in - let real_ftype = get_real_fun gen (apply_params iface.cl_params real_itl f.cf_type) in - replace_mono real_ftype; - let overloads = Overloads.collect_overloads (fun t -> t) c f.cf_name in - try - let t2, f2 = - match overloads with - | (_, cf) :: _ when has_class_field_flag cf CfOverload -> (* overloaded function *) - (* try to find exact function *) - List.find (fun (t,f2) -> - Overloads.same_overload_args ~get_vmtype ftype t f f2 - ) overloads - | _ :: _ -> - (match field_access gen (TInst(c, extract_param_types c.cl_params)) f.cf_name with - | FClassField(_,_,_,f2,false,t,_) -> t,f2 (* if it's not an overload, all functions should have the same signature *) - | _ -> raise Not_found) - | [] -> raise Not_found - in - replace_mono t2; - (* if we find a function with the exact type of real_ftype, it means this interface has already been taken care of *) - if not (type_iseq (get_real_fun gen (apply_params f2.cf_params (extract_param_types f.cf_params) t2)) real_ftype) then begin - (match f.cf_kind with | Method (MethNormal | MethInline) -> () | _ -> raise Not_found); - let t2 = get_real_fun gen t2 in - if List.length f.cf_params <> List.length f2.cf_params then raise Not_found; - replace_mono t2; - match follow (apply_params f2.cf_params (extract_param_types f.cf_params) t2), follow real_ftype with - | TFun(a1,r1), TFun(a2,r2) when not implement_explicitly && not (type_iseq r1 r2) && Overloads.same_overload_args ~get_vmtype real_ftype t2 f f2 -> - (* different return types are the trickiest cases to deal with *) - (* check for covariant return type *) - let is_covariant = match follow r1, follow r2 with - | _, TDynamic _ -> false - | r1, r2 -> try - unify r1 r2; - if like_int r1 then like_int r2 else true - with | Unify_error _ -> false - in - (* we only have to worry about non-covariant issues *) - if not is_covariant then begin - (* override return type and cast implemented function *) - let args, newr = match follow t2, follow (apply_params f.cf_params (extract_param_types f2.cf_params) real_ftype) with - | TFun(a,_), TFun(_,r) -> a,r - | _ -> Globals.die "" __LOC__ - in - f2.cf_type <- TFun(args,newr); - (match f2.cf_expr with - | Some ({ eexpr = TFunction tf } as e) -> - f2.cf_expr <- Some { e with eexpr = TFunction { tf with tf_type = newr } } - | _ -> ()) - end - | TFun(a1,r1), TFun(a2,r2) -> - (* just implement a function that will call the main one *) - let name, is_explicit = match explicit_fn_name with - | Some fn when not (type_iseq r1 r2) && Overloads.same_overload_args ~get_vmtype real_ftype t2 f f2 -> - fn iface itl f.cf_name, true - | _ -> f.cf_name, false - in - let p = f2.cf_pos in - let newf = mk_class_field name real_ftype true f.cf_pos (Method MethNormal) f.cf_params in - (* make sure that there isn't already an overload with the same exact type *) - if List.exists (fun (t,f2) -> - type_iseq (get_real_fun gen t) real_ftype - ) overloads then raise Not_found; - let vars = List.map (fun (n,_,t) -> alloc_var n t) a2 in - - let args = List.map2 (fun v (_,_,t) -> mk_cast t (mk_local v f2.cf_pos)) vars a1 in - let field = { eexpr = TField(this, FInstance(c,extract_param_types c.cl_params,f2)); etype = TFun(a1,r1); epos = p } in - let call = { eexpr = TCall(field, args); etype = r1; epos = p } in - (* let call = gen.gparam_func_call call field (List.map snd f.cf_params) args in *) - let is_void = ExtType.is_void r2 in - - newf.cf_expr <- Some { - eexpr = TFunction({ - tf_args = List.map (fun v -> v,None) vars; - tf_type = r2; - tf_expr = if is_void then call else (Texpr.Builder.mk_return (mk_cast r2 call)); - }); - etype = real_ftype; - epos = p; - }; - (try - let fm = PMap.find name c.cl_fields in - fm.cf_overloads <- newf :: fm.cf_overloads - with | Not_found -> - c.cl_fields <- PMap.add name newf c.cl_fields; - c.cl_ordered_fields <- newf :: c.cl_ordered_fields) - | _ -> Globals.die "" __LOC__ - end - with | Not_found -> () - in - List.iter (fun f -> match f.cf_kind with | Var _ -> () | _ -> loop_f f) iface.cl_ordered_fields - in - List.iter (fun (iface,itl) -> loop_iface iface itl) c.cl_implements; - (* now go through all overrides, *) - let check_f f = - (* find the first declared field *) - let is_overload = has_class_field_flag f CfOverload in - let decl = if is_overload then - find_first_declared_field gen c ~get_vmtype ~exact_field:f f.cf_name - else - find_first_declared_field gen c ~get_vmtype f.cf_name - in - match decl with - | Some(f2,actual_t,_,t,declared_cl,_,_) - when not (Overloads.same_overload_args ~get_vmtype actual_t (get_real_fun gen f.cf_type) f2 f) -> - (match f.cf_expr with - | Some({ eexpr = TFunction(tf) } as e) -> - let actual_args, _ = get_fun (get_real_fun gen actual_t) in - let new_args, vars_to_declare = List.fold_left2 (fun (args,vdecl) (v,_) (_,_,t) -> - if not (type_iseq (gen.greal_type v.v_type) (gen.greal_type t)) then begin - let new_var = mk_temp v.v_name t in - (new_var,None) :: args, (v, Some(mk_cast v.v_type (mk_local new_var f.cf_pos))) :: vdecl - end else - (v,None) :: args, vdecl - ) ([],[]) tf.tf_args actual_args in - let block = { eexpr = TBlock(List.map (fun (v,ve) -> - { - eexpr = TVar(v,ve); - etype = gen.gcon.basic.tvoid; - epos = tf.tf_expr.epos - }) vars_to_declare); - etype = gen.gcon.basic.tvoid; - epos = tf.tf_expr.epos - } in - let has_contravariant_args = match (get_real_fun gen f.cf_type, actual_t) with - | TFun(current_args,_), TFun(original_args,_) -> - List.exists2 (fun (_,_,cur_arg) (_,_,orig_arg) -> try - unify orig_arg cur_arg; - try - unify cur_arg orig_arg; - false - with Unify_error _ -> - true - with Unify_error _ -> false) current_args original_args - | _ -> Globals.die "" __LOC__ - in - if (not (has_class_field_flag f CfOverload) && has_contravariant_args) then - add_class_field_flag f CfOverload; - if has_class_field_flag f CfOverload then begin - (* if it is overload, create another field with the requested type *) - let f3 = mk_class_field f.cf_name t (has_class_field_flag f CfPublic) f.cf_pos f.cf_kind f.cf_params in - let p = f.cf_pos in - let old_args, old_ret = get_fun f.cf_type in - let args, ret = get_fun t in - let tf_args = List.rev new_args in - let f3_mk_return = if ExtType.is_void ret then (fun e -> e) else (fun e -> Texpr.Builder.mk_return (mk_cast ret e)) in - f3.cf_expr <- Some { - eexpr = TFunction({ - tf_args = tf_args; - tf_type = ret; - tf_expr = Type.concat block (mk_block (f3_mk_return { - eexpr = TCall( - { - eexpr = TField( - { eexpr = TConst TThis; etype = TInst(c, extract_param_types c.cl_params); epos = p }, - FInstance(c,extract_param_types c.cl_params,f)); - etype = f.cf_type; - epos = p - }, - List.map2 (fun (v,_) (_,_,t) -> mk_cast t (mk_local v p)) tf_args old_args); - etype = old_ret; - epos = p - })) - }); - etype = t; - epos = p; - }; - (* make sure we skip cast detect - otherwise this new function will make the overload detection go crazy *) - f3.cf_meta <- (Meta.Custom(":skipCastDetect"), [], f3.cf_pos) :: f3.cf_meta; - gen.gafter_expr_filters_ended <- ((fun () -> - f.cf_overloads <- f3 :: f.cf_overloads; - ) :: gen.gafter_expr_filters_ended); - f3 - end else begin - (* if it's not overload, just cast the vars *) - if vars_to_declare <> [] then - f.cf_expr <- Some({ e with - eexpr = TFunction({ tf with - tf_args = List.rev new_args; - tf_expr = Type.concat block tf.tf_expr - }); - }); - f - end - | _ -> f) - | _ -> f - in - if not (has_class_flag c CExtern) then - List.iter (fun f -> - if has_class_field_flag f CfOverride then begin - remove_class_field_flag f CfOverride; - let f2 = check_f f in - add_class_field_flag f2 CfOverride - end - ) c.cl_ordered_fields; - md - | _ -> md - in - run - -let configure ?explicit_fn_name ~get_vmtype gen = - let delay () = - Hashtbl.clear gen.greal_field_types - in - gen.gafter_mod_filters_ended <- delay :: gen.gafter_mod_filters_ended; - let run = run ~explicit_fn_name ~get_vmtype gen in - gen.gmodule_filters#add name (PCustom priority) run diff --git a/src/codegen/gencommon/gencommon.ml b/src/codegen/gencommon/gencommon.ml deleted file mode 100644 index b4af589c180..00000000000 --- a/src/codegen/gencommon/gencommon.ml +++ /dev/null @@ -1,1365 +0,0 @@ -(* - The Haxe Compiler - Copyright (C) 2005-2019 Haxe Foundation - - This program is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License - as published by the Free Software Foundation; either version 2 - of the License, or (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. -*) - -(* - Gen Common API - - This is the key module for generation of Java and C# sources - In order for both modules to share as much code as possible, some - rules were devised: - - - every feature has its own submodule, and may contain the following methods: - - configure - sets all the configuration variables for the module to run. If a module has this method, - it *should* be called once before running any filter - - run_filter -> - runs the filter immediately on the context - - add_filter -> - adds the filter to an expr->expr list. Most filter modules will provide this option so the filter - function can only run once. - - most submodules will have side-effects so the order of operations will matter. - When running configure / add_filter this might be taken care of with the rule-based dispatch system working - underneath, but still there might be some incompatibilities. There will be an effort to document it. - The modules can hint on the order by suffixing their functions with _first or _last. - - any of those methods might have different parameters, that configure how the filter will run. - For example, a simple filter that maps switch() expressions to if () .. else if... might receive - a function that filters what content should be mapped - - Other targets can use those filters on their own code. In order to do that, - a simple configuration step is needed: you need to initialize a generator_ctx type with - Gencommon.new_gen (context:Common.context) - with a generator_ctx context you will be able to add filters to your code, and execute them with - Gencommon.run_filters (gen_context:Gencommon.generator_ctx) - - After running the filters, you can run your own generator normally. - - (* , or you can run - Gencommon.generate_modules (gen_context:Gencommon.generator_ctx) (extension:string) (module_gen:module_type list->bool) - where module_gen will take a whole module (can be *) -*) -open Unix -open Ast -open Type -open Common -open Globals -open Option -open Printf -open ExtString -open Overloads - -(* ******************************************* *) -(* common helpers *) -(* ******************************************* *) - -let rec like_float t = - match follow t with - | TAbstract ({ a_path = ([], "Float") }, []) - | TAbstract ({ a_path = ([], "Int") }, []) -> - true - | TAbstract ({ a_path = (["cs"], "Pointer") }, _) -> - false - | TAbstract (a, _) -> - List.exists like_float a.a_from || List.exists like_float a.a_to - | _ -> - false - -let rec like_int t = - match follow t with - | TAbstract ({ a_path = ([], "Int") }, []) -> - true - | TAbstract ({ a_path = (["cs"], "Pointer") }, _) -> - false - | TAbstract (a, _) -> - List.exists like_int a.a_from || List.exists like_int a.a_to - | _ -> - false - -let rec like_i64 t = - match follow t with - | TAbstract ({ a_path = (["cs"], ("Int64" | "UInt64")) }, []) - | TAbstract ({ a_path = (["java"], "Int64") }, []) - | TAbstract ({ a_path = (["haxe"], "Int64") }, []) -> - true - | TAbstract (a, _) -> - List.exists like_i64 a.a_from || List.exists like_i64 a.a_to - | _ -> - false - -let follow_once t = - match t with - | TMono r -> - (match r.tm_type with - | Some t -> t - | _ -> t_dynamic) (* avoid infinite loop / should be the same in this context *) - | TLazy f -> - lazy_type f - | TType (t,tl) -> - apply_typedef t tl - | TAbstract({a_path = [],"Null"},[t]) -> - t - | _ -> - t - -let t_empty = mk_anon (ref Closed) - -let alloc_var n t = Type.alloc_var VGenerated n t null_pos - -let mk_local = Texpr.Builder.make_local - -(* the undefined is a special var that works like null, but can have special meaning *) -let undefined = - (fun pos -> mk (TIdent "__undefined__") t_dynamic pos) - -let path_of_md_def md_def = - match md_def.m_types with - | [TClassDecl c] -> c.cl_path - | _ -> md_def.m_path - -let debug_type t = (s_type (print_context())) t -let debug_expr = s_expr_ast true "" debug_type - -let debug_mode = ref false -let trace s = if !debug_mode then print_endline s else () -let timer name = if !debug_mode then Timer.timer name else fun () -> () - -let is_string t = - match follow t with - | TInst({ cl_path = ([], "String") }, []) -> true - | _ -> false - -let anon_class t = - match follow t with - | TAnon anon -> - (match !(anon.a_status) with - | ClassStatics cl -> Some (TClassDecl cl) - | EnumStatics e -> Some (TEnumDecl e) - | AbstractStatics a -> Some (TAbstractDecl a) - | _ -> None) - | _ -> None - - let rec t_to_md t = match t with - | TInst (cl,_) -> TClassDecl cl - | TEnum (e,_) -> TEnumDecl e - | TType (t,_) -> TTypeDecl t - | TAbstract (a,_) -> TAbstractDecl a - | TAnon anon -> - (match !(anon.a_status) with - | EnumStatics e -> TEnumDecl e - | ClassStatics cl -> TClassDecl cl - | AbstractStatics a -> TAbstractDecl a - | _ -> die "" __LOC__) - | TLazy f -> t_to_md (lazy_type f) - | TMono r -> (match r.tm_type with | Some t -> t_to_md t | None -> die "" __LOC__) - | _ -> die "" __LOC__ - - -let get_cl mt = match mt with TClassDecl cl -> cl | _ -> failwith (Printf.sprintf "Unexpected module type (class expected) for %s: %s" (s_type_path (t_path mt)) (s_module_type_kind mt)) -let get_abstract mt = match mt with TAbstractDecl a -> a | _ -> failwith (Printf.sprintf "Unexpected module type (abstract expected) for %s: %s" (s_type_path (t_path mt)) (s_module_type_kind mt)) - -let get_fun t = - match follow t with - | TFun (args, ret) -> args, ret - | t -> (trace (debug_type t)); die "" __LOC__ - -let mk_cast t e = Type.mk_cast e t e.epos - -(** TODO: when adding new AST, make a new cast type for those fast casts. For now, we're using this hack - * of using null_class to tell a fast cast from a normal one. Also note that this only works since both - * C# and Java do not use the second part of TCast for anything *) -let mk_castfast t e = { e with eexpr = TCast(e, Some (TClassDecl null_class)); etype = t } - -let mk_static_field_access_infer cl field pos params = - try - let e_type = Texpr.Builder.make_static_this cl pos in - let cf = PMap.find field cl.cl_statics in - let t = if params = [] then cf.cf_type else apply_params cf.cf_params params cf.cf_type in - mk (TField(e_type, FStatic(cl, cf))) t pos - with Not_found -> - failwith ("Cannot find field " ^ field ^ " in class " ^ (s_type_path cl.cl_path)) - -let mk_static_field_access cl field fieldt pos = - { (mk_static_field_access_infer cl field pos []) with etype = fieldt } - -(* stolen from Hugh's sources ;-) *) -(* this used to be a class, but there was something in there that crashed ocaml native compiler in windows *) -module SourceWriter = -struct - - type source_writer = - { - sw_buf : Buffer.t; - mutable sw_has_content : bool; - mutable sw_indent : string; - mutable sw_indents : string list; - } - - let new_source_writer () = - { - sw_buf = Buffer.create 0; - sw_has_content = false; - sw_indent = ""; - sw_indents = []; - } - - let add_writer w_write w_read = Buffer.add_buffer w_read.sw_buf w_write.sw_buf - - let contents w = Buffer.contents w.sw_buf - - let len w = Buffer.length w.sw_buf - - let write w x = - (if not w.sw_has_content then begin w.sw_has_content <- true; Buffer.add_string w.sw_buf w.sw_indent; Buffer.add_string w.sw_buf x; end else Buffer.add_string w.sw_buf x); - let len = (String.length x)-1 in - if len >= 0 && String.get x len = '\n' then begin w.sw_has_content <- false end else w.sw_has_content <- true - - let push_indent w = w.sw_indents <- "\t"::w.sw_indents; w.sw_indent <- String.concat "" w.sw_indents - - let pop_indent w = - match w.sw_indents with - | h::tail -> w.sw_indents <- tail; w.sw_indent <- String.concat "" w.sw_indents - | [] -> w.sw_indent <- "/*?*/" - - let newline w = write w "\n" - - let begin_block w = (if w.sw_has_content then newline w); write w "{"; push_indent w; newline w - - let end_block w = pop_indent w; (if w.sw_has_content then newline w); write w "}"; newline w - - let print w = - (if not w.sw_has_content then begin w.sw_has_content <- true; Buffer.add_string w.sw_buf w.sw_indent end); - bprintf w.sw_buf; - -end;; - -(* rule_dispatcher's priority *) -type priority = - | PFirst - | PLast - | PZero - | PCustom of float - -exception DuplicateName of string -exception NoRulesApplied - -let indent = ref [] - -(* the rule dispatcher is the primary way to deal with distributed "plugins" *) -(* we will define rules that will form a distributed / extensible match system *) -class ['tp, 'ret] rule_dispatcher name = - object(self) - val tbl = Hashtbl.create 16 - val mutable keys = [] - val names = Hashtbl.create 16 - - method add (name : string) (* name helps debugging *) (priority : priority) (rule : 'tp->'ret option) = - let p = match priority with - | PFirst -> infinity - | PLast -> neg_infinity - | PZero -> 0.0 - | PCustom i -> i - in - - let q = if not( Hashtbl.mem tbl p ) then begin - let q = Stack.create() in - Hashtbl.add tbl p q; - keys <- p :: keys; - keys <- List.sort (fun x y -> - (compare x y)) keys; - q - end else Hashtbl.find tbl p in - (if Hashtbl.mem names name then raise (DuplicateName(name))); - Hashtbl.add names name q; - - Stack.push (name, rule) q - - method describe = - Hashtbl.iter (fun s _ -> (trace s)) names; - - method run_f tp = get (self#run tp) - - method run_from (priority:float) (tp:'tp) : 'ret option = - let ok = ref false in - let ret = ref None in - indent := "\t" :: !indent; - - (try begin - List.iter (fun key -> - if key < priority then begin - let q = Hashtbl.find tbl key in - Stack.iter (fun (n, rule) -> - let t = if !debug_mode then Timer.timer [("rule dispatcher rule: " ^ n)] else fun () -> () in - let r = rule(tp) in - t(); - if is_some r then begin ret := r; raise Exit end - ) q - end - ) keys - - end with Exit -> ok := true); - - (match !indent with - | [] -> () - | h::t -> indent := t); - - (if not (!ok) then raise NoRulesApplied); - !ret - - method run (tp:'tp) : 'ret option = - self#run_from infinity tp - -end;; - -(* this is a special case where tp = tret and you stack their output as the next's input *) -class ['tp] rule_map_dispatcher name = object(self) - val tbl = Hashtbl.create 16 - val mutable keys = [] - val names = Hashtbl.create 16 - - method add (name : string) (* name helps debugging *) (priority : priority) (rule : 'tp->'tp) = - let p = match priority with - | PFirst -> infinity - | PLast -> neg_infinity - | PZero -> 0.0 - | PCustom i -> i - in - let q = if not (Hashtbl.mem tbl p) then begin - let q = Stack.create() in - Hashtbl.add tbl p q; - keys <- p :: keys; - keys <- List.sort (fun x y -> - (compare x y)) keys; - q - end else Hashtbl.find tbl p in - if Hashtbl.mem names name then raise (DuplicateName name); - Hashtbl.add names name q; - - Stack.push (name, rule) q - - method describe = - Hashtbl.iter (fun s _ -> (trace s)) names; - - method run (tp:'tp) : 'tp = - self#run_from infinity tp - - method run_from (priority:float) (tp:'tp) : 'tp = - let cur = ref tp in - List.iter (fun key -> - if key < priority then begin - let q = Hashtbl.find tbl key in - Stack.iter (fun (n, rule) -> - trace ("running rule " ^ n); - let t = if !debug_mode then Timer.timer [("rule map dispatcher rule: " ^ n)] else fun () -> () in - cur := rule !cur; - t(); - ) q - end - ) keys; - !cur -end;; - - -type generator_ctx = -{ - (* these are the basic context fields. If another target is using this context, *) - (* this is all you need to care about *) - gcon : Common.context; - - gentry_point : (string * tclass * texpr) option; - - gclasses : gen_classes; - - gtools : gen_tools; - - gwarning : Warning.warning -> string -> pos -> unit; - - (* - module filters run before module filters and they should generate valid haxe syntax as a result. - Module filters shouldn't go through the expressions as it adds an unnecessary burden to the GC, - and it can all be done in a single step with gexpr_filters and proper priority selection. - - As a convention, Module filters should end their name with Modf, so they aren't mistaken with expression filters - *) - gmodule_filters : (module_type) rule_map_dispatcher; - - (* - expression filters are the most common filters to be applied. - They should also generate only valid haxe expressions, so e.g. calls to non-existant methods - should be avoided, although there are some ways around them (like gspecial_methods) - *) - gexpr_filters : (texpr) rule_map_dispatcher; - (* - syntax filters are also expression filters but they no longer require - that the resulting expressions be valid haxe expressions. - They then have no guarantee that either the input expressions or the output one follow the same - rules as normal haxe code. - *) - gsyntax_filters : (texpr) rule_map_dispatcher; - - (* these are more advanced features, but they would require a rewrite of targets *) - (* they are just helpers to ditribute functions like "follow" or "type to string" *) - (* so adding a module will already take care of correctly following a certain type of *) - (* variable, for example *) - - (* follows the type through typedefs, lazy typing, etc. *) - (* it's the place to put specific rules to handle typedefs, like *) - (* other basic types like UInt *) - gfollow : (t, t) rule_dispatcher; - - gtypes : (path, module_type) Hashtbl.t; - mutable gtypes_list : module_type list; - mutable gmodules : Type.module_def list; - - (* cast detection helpers / settings *) - (* this is a cache for all field access types *) - greal_field_types : (path * string, (tclass_field (* does the cf exist *) * t (*cf's type in relation to current class type params *) * t * tclass (* declared class *) ) option) Hashtbl.t; - (* this function allows any code to handle casts as if it were inside the cast_detect module *) - mutable ghandle_cast : t->t->texpr->texpr; - (* when an unsafe cast is made, we can warn the user *) - mutable gon_unsafe_cast : t->t->pos->unit; - (* does this type needs to be boxed? Normally always false, unless special type handling must be made *) - mutable gneeds_box : t->bool; - (* does this 'special type' needs cast to this other type? *) - (* this is here so we can implement custom behavior for "opaque" typedefs *) - mutable gspecial_needs_cast : t->t->bool; - (* sometimes we may want to support unrelated conversions on cast detection *) - (* for example, haxe.lang.Null -> T on C# *) - (* every time an unrelated conversion is found, each to/from path is searched on this hashtbl *) - (* if found, the function will be executed with from_type, to_type. If returns true, it means that *) - (* it is a supported conversion, and the unsafe cast routine changes to a simple cast *) - gsupported_conversions : (path, t->t->bool) Hashtbl.t; - - (* API for filters *) - (* add type can be called at any time, and will add a new module_def that may or may not be filtered *) - (* module_type -> should_filter *) - mutable gadd_type : module_type -> bool -> unit; - (* during expr filters, add_to_module will be available so module_types can be added to current module_def. we must pass the priority argument so the filters can be resumed *) - mutable gadd_to_module : module_type -> float -> unit; - (* during expr filters, shows the current class path *) - mutable gcurrent_path : path; - (* current class *) - mutable gcurrent_class : tclass option; - (* current class field, if any *) - mutable gcurrent_classfield : tclass_field option; - - (* events *) - (* after module filters ended *) - mutable gafter_mod_filters_ended : (unit -> unit) list; - (* after expression filters ended *) - mutable gafter_expr_filters_ended : (unit -> unit) list; - (* after all filters are run *) - mutable gafter_filters_ended : (unit -> unit) list; - - mutable gbase_class_fields : (string, tclass_field) PMap.t; - - (* real type is the type as it is read by the target. *) - (* This function is here because most targets don't have *) - (* a 1:1 translation between haxe types and its native types *) - (* But types aren't changed to this representation as we might lose *) - (* some valuable type information in the process *) - mutable greal_type : t -> t; - (* - the same as greal_type but for type parameters. - *) - mutable greal_type_param : module_type -> tparams -> tparams; - (* - is the type a value type? - This may be used in some optimizations where reference types and value types - are handled differently. At first the default is very good to use, and if tweaks are needed, - it's best to be done by adding @:struct meta to the value types - * - mutable gis_value_type : t -> bool;*) - - (* misc configuration *) - (* - Should the target allow type parameter dynamic conversion, - or should we add a cast to those cases as well? - *) - mutable gallow_tp_dynamic_conversion : bool; - - (* internal apis *) - (* param_func_call : used by RealTypeParams and CastDetection *) - mutable gparam_func_call : texpr->texpr->tparams->texpr list->texpr; - (* does it already have a type parameter cast handler? This is used by CastDetect to know if it should handle type parameter casts *) - mutable ghas_tparam_cast_handler : bool; - (* type parameter casts - special cases *) - (* function cast_from, cast_to -> texpr *) - gtparam_cast : (path, (texpr->t->texpr)) Hashtbl.t; - - (* - special vars are used for adding special behavior to - *) - gspecial_vars : (string, bool) Hashtbl.t; -} - -and gen_classes = -{ - cl_reflect : tclass; - cl_type : tclass; - cl_dyn : tclass; - - mutable nativearray_len : texpr -> pos -> texpr; - mutable nativearray_type : Type.t -> Type.t; - mutable nativearray : Type.t -> Type.t; -} - -(* add here all reflection transformation additions *) -and gen_tools = -{ - (* Reflect.fields(). The bool is if we are iterating in a read-only manner. If it is read-only we might not need to allocate a new array *) - r_fields : bool->texpr->texpr; - (* (first argument = return type. should be void in most cases) Reflect.setField(obj, field, val) *) - r_set_field : t->texpr->texpr->texpr->texpr; - (* Reflect.field. bool indicates if is safe (no error throwing) or unsafe; t is the expected return type true = safe *) - r_field : bool->t->texpr->texpr->texpr; - - (* - return an expression that creates an unitialized instance of a class, used for the generic cast helper method. - *) - mutable r_create_empty : tclass->tparams->pos->texpr; -} - -(** - Function that receives a desired name and makes it "internal", doing the best to ensure that it will not be called from outside. - To avoid name clashes between internal names, user must specify two strings: a "namespace" and the name itself -*) -let mk_internal_name ns name = Printf.sprintf "__%s_%s" ns name - -let mk_temp, reset_temps = - let tmp_count = ref 0 in - (fun name t -> - incr tmp_count; - let name = mk_internal_name "temp" (name ^ (string_of_int !tmp_count)) in - alloc_var name t - ), - (fun () -> tmp_count := 0) - -let new_ctx con = - let types = Hashtbl.create (List.length con.types) in - List.iter (fun mt -> - match mt with - | TClassDecl cl -> Hashtbl.add types cl.cl_path mt - | TEnumDecl e -> Hashtbl.add types e.e_path mt - | TTypeDecl t -> Hashtbl.add types t.t_path mt - | TAbstractDecl a -> - (* There are some cases where both an abstract and a class - have the same name (e.g. java.lang.Double/Integer/etc) - in this case we generally want the class to have priority *) - if not (Hashtbl.mem types a.a_path) then - Hashtbl.add types a.a_path mt - ) con.types; - - let get_type path = - List.find (fun md -> (t_path md) = path) con.types - in - - let cl_dyn = match get_type ([], "Dynamic") with - | TClassDecl c -> c - | TAbstractDecl a -> - mk_class a.a_module ([], "Dynamic") a.a_pos null_pos - | _ -> die "" __LOC__ - in - - let rec gen = { - gcon = con; - gwarning = (fun w msg p -> - let options = Option.map_default (fun c -> Warning.from_meta c.cl_meta) [] gen.gcurrent_class in - let options = options @ Option.map_default (fun cf -> Warning.from_meta cf.cf_meta) [] gen.gcurrent_classfield in - con.warning w options msg p - ); - gentry_point = get_entry_point con; - gclasses = { - cl_reflect = get_cl (get_type ([], "Reflect")); - cl_type = get_cl (get_type ([], "Type")); - cl_dyn = cl_dyn; - - nativearray = (fun _ -> die "" __LOC__); - nativearray_type = (fun _ -> die "" __LOC__); - nativearray_len = (fun _ -> die "" __LOC__); - }; - gtools = { - r_fields = (fun is_used_only_by_iteration expr -> - let fieldcall = mk_static_field_access_infer gen.gclasses.cl_reflect "fields" expr.epos [] in - { eexpr = TCall(fieldcall, [expr]); etype = gen.gcon.basic.tarray gen.gcon.basic.tstring; epos = expr.epos } - ); - (* Reflect.setField(obj, field, val). t by now is ignored. FIXME : fix this implementation *) - r_set_field = (fun t obj field v -> - let fieldcall = mk_static_field_access_infer gen.gclasses.cl_reflect "setField" v.epos [] in - { eexpr = TCall(fieldcall, [obj; field; v]); etype = t_dynamic; epos = v.epos } - ); - (* Reflect.field. bool indicates if is safe (no error throwing) or unsafe. true = safe *) - r_field = (fun is_safe t obj field -> - let fieldcall = mk_static_field_access_infer gen.gclasses.cl_reflect "field" obj.epos [] in - (* FIXME: should we see if needs to cast? *) - mk_cast t { eexpr = TCall(fieldcall, [obj; field]); etype = t_dynamic; epos = obj.epos } - ); - - r_create_empty = (fun _ _ pos -> gen.gcon.error "r_create_empty implementation is not provided" pos; die "" __LOC__); - }; - gexpr_filters = new rule_map_dispatcher "gexpr_filters"; - gmodule_filters = new rule_map_dispatcher "gmodule_filters"; - gsyntax_filters = new rule_map_dispatcher "gsyntax_filters"; - gfollow = new rule_dispatcher "gfollow"; - gtypes = types; - gtypes_list = con.types; - gmodules = con.modules; - - greal_field_types = Hashtbl.create 0; - ghandle_cast = (fun to_t from_t e -> mk_cast to_t e); - gon_unsafe_cast = (fun t t2 pos -> (gen.gwarning WGenerator ("Type " ^ (debug_type t2) ^ " is being cast to the unrelated type " ^ (s_type (print_context()) t)) pos)); - gneeds_box = (fun t -> false); - gspecial_needs_cast = (fun to_t from_t -> false); - gsupported_conversions = Hashtbl.create 0; - - gadd_type = (fun md should_filter -> - if should_filter then begin - gen.gtypes_list <- md :: gen.gtypes_list; - gen.gmodules <- { m_id = alloc_mid(); m_path = (t_path md); m_types = [md]; m_statics = None; m_extra = module_extra "" "" 0. MFake gen.gcon.compilation_step [] } :: gen.gmodules; - Hashtbl.add gen.gtypes (t_path md) md; - end else gen.gafter_filters_ended <- (fun () -> - gen.gtypes_list <- md :: gen.gtypes_list; - gen.gmodules <- { m_id = alloc_mid(); m_path = (t_path md); m_types = [md]; m_statics = None; m_extra = module_extra "" "" 0. MFake gen.gcon.compilation_step [] } :: gen.gmodules; - Hashtbl.add gen.gtypes (t_path md) md; - ) :: gen.gafter_filters_ended; - ); - gadd_to_module = (fun md pr -> failwith "module added outside expr filters"); - gcurrent_path = ([],""); - gcurrent_class = None; - gcurrent_classfield = None; - - gafter_mod_filters_ended = []; - gafter_expr_filters_ended = []; - gafter_filters_ended = []; - - gbase_class_fields = PMap.empty; - - greal_type = (fun t -> t); - greal_type_param = (fun _ t -> t); - - gallow_tp_dynamic_conversion = false; - - (* as a default, ignore the params *) - gparam_func_call = (fun ecall efield params elist -> { ecall with eexpr = TCall(efield, elist) }); - ghas_tparam_cast_handler = false; - gtparam_cast = Hashtbl.create 0; - - gspecial_vars = Hashtbl.create 0; - } in - gen - -let init_ctx gen = - (* ultimately add a follow once handler as the last follow handler *) - let follow_f = gen.gfollow#run in - let follow t = - match t with - | TMono r -> - (match r.tm_type with - | Some t -> follow_f t - | _ -> Some t) - | TLazy f -> - follow_f (lazy_type f) - | TType (t,tl) -> - follow_f (apply_typedef t tl) - | TAbstract({a_path = [],"Null"},[t]) -> - follow_f t - | _ -> Some t - in - gen.gfollow#add "final" PLast follow - -let run_follow gen = gen.gfollow#run_f - -let reorder_modules gen = - let modules = Hashtbl.create 20 in - List.iter (fun md -> - Hashtbl.add modules ( (t_infos md).mt_module ).m_path md - ) gen.gtypes_list; - - gen.gmodules <- []; - let processed = Hashtbl.create 20 in - Hashtbl.iter (fun md_path md -> - if not (Hashtbl.mem processed md_path) then begin - Hashtbl.add processed md_path true; - gen.gmodules <- { m_id = alloc_mid(); m_path = md_path; m_types = List.rev ( Hashtbl.find_all modules md_path ); m_statics = None; m_extra = (t_infos md).mt_module.m_extra } :: gen.gmodules - end - ) modules - -let run_filters_from gen t filters = - match t with - | TClassDecl c when not (FiltersCommon.is_removable_class c) -> - trace (snd c.cl_path); - gen.gcurrent_path <- c.cl_path; - gen.gcurrent_class <- Some(c); - - gen.gcurrent_classfield <- None; - let rec process_field f = - reset_temps(); - gen.gcurrent_classfield <- Some(f); - - trace f.cf_name; - (match f.cf_expr with - | None -> () - | Some e -> - f.cf_expr <- Some (List.fold_left (fun e f -> f e) e filters)); - List.iter process_field f.cf_overloads; - in - List.iter process_field c.cl_ordered_fields; - List.iter process_field c.cl_ordered_statics; - - (match c.cl_constructor with - | None -> () - | Some f -> process_field f); - gen.gcurrent_classfield <- None; - (match c.cl_init with - | None -> () - | Some f -> - process_field f); - | TClassDecl _ | TEnumDecl _ | TTypeDecl _ | TAbstractDecl _ -> - () - -let run_filters gen = - let last_error = gen.gcon.error_ext in - let has_errors = ref false in - gen.gcon.error_ext <- (fun err -> has_errors := true; last_error err); - (* first of all, we have to make sure that the filters won't trigger a major Gc collection *) - let t = Timer.timer ["gencommon_filters"] in - (if Common.defined gen.gcon Define.GencommonDebug then debug_mode := true else debug_mode := false); - let run_filters (filter : texpr rule_map_dispatcher) = - let rec loop acc mds = - match mds with - | [] -> acc - | md :: tl -> - let filters = [ filter#run ] in - let added_types = ref [] in - gen.gadd_to_module <- (fun md_type priority -> - gen.gtypes_list <- md_type :: gen.gtypes_list; - added_types := (md_type, priority) :: !added_types - ); - - run_filters_from gen md filters; - - let added_types = List.map (fun (t,p) -> - run_filters_from gen t [ fun e -> filter#run_from p e ]; - if Hashtbl.mem gen.gtypes (t_path t) then begin - let rec loop i = - let p = t_path t in - let new_p = (fst p, snd p ^ "_" ^ (string_of_int i)) in - if Hashtbl.mem gen.gtypes new_p then - loop (i+1) - else - match t with - | TClassDecl cl -> cl.cl_path <- new_p - | TEnumDecl e -> e.e_path <- new_p - | TTypeDecl _ | TAbstractDecl _ -> () - in - loop 0 - end; - Hashtbl.add gen.gtypes (t_path t) t; - t - ) !added_types in - - loop (added_types @ (md :: acc)) tl - in - List.rev (loop [] gen.gtypes_list) - in - - let run_mod_filter (filter : module_type rule_map_dispatcher) = - let last_add_to_module = gen.gadd_to_module in - let added_types = ref [] in - gen.gadd_to_module <- (fun md_type priority -> - Hashtbl.add gen.gtypes (t_path md_type) md_type; - added_types := (md_type, priority) :: !added_types - ); - - let rec loop processed not_processed = - match not_processed with - | hd :: tl -> - (match hd with - | TClassDecl c -> - gen.gcurrent_class <- Some c - | _ -> - gen.gcurrent_class <- None); - let new_hd = filter#run hd in - - let added_types_new = !added_types in - added_types := []; - let added_types = List.map (fun (t,p) -> filter#run_from p t) added_types_new in - - loop ( added_types @ (new_hd :: processed) ) tl - | [] -> - processed - in - - let filtered = loop [] gen.gtypes_list in - gen.gadd_to_module <- last_add_to_module; - gen.gtypes_list <- List.rev (filtered) - in - - run_mod_filter gen.gmodule_filters; - List.iter (fun fn -> fn()) gen.gafter_mod_filters_ended; - - let last_add_to_module = gen.gadd_to_module in - gen.gtypes_list <- run_filters gen.gexpr_filters; - gen.gadd_to_module <- last_add_to_module; - - List.iter (fun fn -> fn()) gen.gafter_expr_filters_ended; - gen.gtypes_list <- run_filters gen.gsyntax_filters; - List.iter (fun fn -> fn()) gen.gafter_filters_ended; - - reorder_modules gen; - t(); - if !has_errors then Error.abort "Compilation aborted with errors" null_pos - -(* ******************************************* *) -(* basic generation module that source code compilation implementations can use *) -(* ******************************************* *) - -let write_file gen w source_dir path extension out_files = - let t = timer ["write";"file"] in - let s_path = source_dir ^ "/" ^ (snd path) ^ "." ^ (extension) in - (* create the folders if they don't exist *) - Path.mkdir_from_path s_path; - - let contents = SourceWriter.contents w in - let should_write = if not (Common.defined gen.gcon Define.ReplaceFiles) && Sys.file_exists s_path then begin - let in_file = open_in s_path in - let old_contents = Std.input_all in_file in - close_in in_file; - contents <> old_contents - end else true in - - if should_write then begin - let f = open_out_bin s_path in - output_string f contents; - close_out f - end; - - out_files := (gen.gcon.file_keys#get s_path) :: !out_files; - - t() - - -let clean_files gen path excludes verbose = - let rec iter_files pack dir path = try - let file = Unix.readdir dir in - - if file <> "." && file <> ".." then begin - let filepath = path ^ "/" ^ file in - if (Unix.stat filepath).st_kind = S_DIR then - let pack = pack @ [file] in - iter_files (pack) (Unix.opendir filepath) filepath; - try Unix.rmdir filepath with Unix.Unix_error (ENOTEMPTY,_,_) -> (); - else if not (String.ends_with filepath ".meta") && not (List.mem (gen.gcon.file_keys#get filepath) excludes) then begin - if verbose then print_endline ("Removing " ^ filepath); - Sys.remove filepath - end - end; - - iter_files pack dir path - with | End_of_file | Unix.Unix_error _ -> - Unix.closedir dir - in - iter_files [] (Unix.opendir path) path - - -let dump_descriptor gen name path_s module_s = - let w = SourceWriter.new_source_writer () in - (* dump called path *) - SourceWriter.write w (Sys.getcwd()); - SourceWriter.newline w; - (* dump all defines. deprecated *) - SourceWriter.write w "begin defines"; - SourceWriter.newline w; - PMap.iter (fun name _ -> - SourceWriter.write w name; - SourceWriter.newline w - ) gen.gcon.defines.Define.values; - SourceWriter.write w "end defines"; - SourceWriter.newline w; - (* dump all defines with their values; keeping the old defines for compatibility *) - SourceWriter.write w "begin defines_data"; - SourceWriter.newline w; - PMap.iter (fun name v -> - SourceWriter.write w name; - SourceWriter.write w "="; - SourceWriter.write w v; - SourceWriter.newline w - ) gen.gcon.defines.Define.values; - SourceWriter.write w "end defines_data"; - SourceWriter.newline w; - (* dump all generated types *) - SourceWriter.write w "begin modules"; - SourceWriter.newline w; - let main_paths = Hashtbl.create 0 in - List.iter (fun md_def -> - SourceWriter.write w "M "; - SourceWriter.write w (path_s (path_of_md_def md_def)); - SourceWriter.newline w; - List.iter (fun m -> - match m with - | TClassDecl cl when not (has_class_flag cl CExtern) -> - SourceWriter.write w "C "; - let s = module_s m in - Hashtbl.add main_paths cl.cl_path s; - SourceWriter.write w (s); - SourceWriter.newline w - | TEnumDecl e when not e.e_extern -> - SourceWriter.write w "E "; - SourceWriter.write w (module_s m); - SourceWriter.newline w - | _ -> () (* still no typedef or abstract is generated *) - ) md_def.m_types - ) gen.gmodules; - SourceWriter.write w "end modules"; - SourceWriter.newline w; - (* dump all resources *) - (match gen.gentry_point with - | Some (_,cl,_) -> - SourceWriter.write w "begin main"; - SourceWriter.newline w; - let path = cl.cl_path in - (try - SourceWriter.write w (Hashtbl.find main_paths path) - with Not_found -> - SourceWriter.write w (path_s path)); - SourceWriter.newline w; - SourceWriter.write w "end main"; - SourceWriter.newline w - | _ -> ()); - SourceWriter.write w "begin resources"; - SourceWriter.newline w; - Hashtbl.iter (fun name _ -> - SourceWriter.write w name; - SourceWriter.newline w - ) gen.gcon.resources; - SourceWriter.write w "end resources"; - SourceWriter.newline w; - SourceWriter.write w "begin libs"; - SourceWriter.newline w; - let path file ext = - if Sys.file_exists file then - file - else try Common.find_file gen.gcon file with - | Not_found -> try Common.find_file gen.gcon (file ^ ext) with - | Not_found -> - file - in - if Common.platform gen.gcon Java then - List.iter (fun java_lib -> - if not (java_lib#has_flag NativeLibraries.FlagIsStd) && not (java_lib#has_flag NativeLibraries.FlagIsExtern) then begin - SourceWriter.write w (path java_lib#get_file_path ".jar"); - SourceWriter.newline w; - end - ) gen.gcon.native_libs.java_libs - else if Common.platform gen.gcon Cs then - List.iter (fun net_lib -> - if not (net_lib#has_flag NativeLibraries.FlagIsStd) && not (net_lib#has_flag NativeLibraries.FlagIsExtern) then begin - SourceWriter.write w (path net_lib#get_name ".dll"); - SourceWriter.newline w; - end - ) gen.gcon.native_libs.net_libs; - SourceWriter.write w "end libs"; - SourceWriter.newline w; - let args = gen.gcon.c_args in - if args <> [] then begin - SourceWriter.write w "begin opts"; - SourceWriter.newline w; - List.iter (fun opt -> SourceWriter.write w opt; SourceWriter.newline w) (List.rev args); - SourceWriter.write w "end opts"; - SourceWriter.newline w; - end; - - let contents = SourceWriter.contents w in - let f = open_out (gen.gcon.file ^ "/" ^ name) in - output_string f contents; - close_out f - -(* - various helper functions -*) - -let mk_paren e = - match e.eexpr with | TParenthesis _ -> e | _ -> { e with eexpr=TParenthesis(e) } - -(* private *) - -let get_real_fun gen t = - match follow t with - | TFun(args,t) -> TFun(List.map (fun (n,o,t) -> n,o,gen.greal_type t) args, gen.greal_type t) - | _ -> t - -let mk_nativearray_decl gen t el pos = - mk (TCall (mk (TIdent "__array__") t_dynamic pos, el)) (gen.gclasses.nativearray t) pos - - -let get_boxed gen t = - let get path = - try type_of_module_type (Hashtbl.find gen.gtypes path) - with Not_found -> t - in - match follow t with - | TAbstract({ a_path = ([],"Bool") }, []) -> - get (["java";"lang"], "Boolean") - | TAbstract({ a_path = ([],"Float") }, []) -> - get (["java";"lang"], "Double") - | TAbstract({ a_path = ([],"Int") }, []) -> - get (["java";"lang"], "Integer") - | TAbstract({ a_path = (["java"],"Int8") }, []) -> - get (["java";"lang"], "Byte") - | TAbstract({ a_path = (["java"],"Int16") }, []) -> - get (["java";"lang"], "Short") - | TAbstract({ a_path = (["java"],"Char16") }, []) -> - get (["java";"lang"], "Character") - | TAbstract({ a_path = ([],"Single") }, []) -> - get (["java";"lang"], "Float") - | TAbstract({ a_path = (["java"],"Int64") }, []) - | TAbstract({ a_path = (["haxe"],"Int64") }, []) -> - get (["java";"lang"], "Long") - | _ -> t - -(** - Wraps rest arguments into a native array. - E.g. transforms params from `callee(param, rest1, rest2, ..., restN)` into - `callee(param, untyped __array__(rest1, rest2, ..., restN))` -*) -let wrap_rest_args gen callee_type params p = - match follow callee_type with - | TFun(args, _) -> - let rec loop args params = - match args, params with - (* last argument expects rest parameters *) - | [(_,_,t)], params when ExtType.is_rest (follow t) -> - (match params with - (* In case of `...rest` just use `rest` *) - | [{ eexpr = TUnop(Spread,Prefix,e) }] -> [e] - (* In other cases: `untyped __array__(param1, param2, ...)` *) - | _ -> - match Abstract.follow_with_abstracts t with - | TInst ({ cl_path = _,"NativeArray" }, [t1]) -> - let t1 = if Common.defined gen.gcon Define.EraseGenerics then t_dynamic else get_boxed gen t1 in - [mk_nativearray_decl gen t1 params (punion_el p params)] - | _ -> - die ~p "Unexpected rest arguments type" __LOC__ - ) - | a :: args, e :: params -> - e :: loop args params - | [], params -> - params - | _ :: _, [] -> - [] - in - loop args params - | _ -> params - -let ensure_local com block name e = - match e.eexpr with - | TLocal _ -> e - | _ -> - let v = mk_temp name e.etype in - block := (mk (TVar (v, Some e)) com.basic.tvoid e.epos) :: !block; - mk_local v e.epos - -let follow_module follow_func md = match md with - | TClassDecl _ - | TEnumDecl _ - | TAbstractDecl _ -> md - | TTypeDecl tdecl -> match (follow_func (TType(tdecl, extract_param_types tdecl.t_params))) with - | TInst(cl,_) -> TClassDecl cl - | TEnum(e,_) -> TEnumDecl e - | TType(t,_) -> TTypeDecl t - | TAbstract(a,_) -> TAbstractDecl a - | _ -> die "" __LOC__ - -(* - hxgen means if the type was generated by haxe. If a type was generated by haxe, it means - it will contain special constructs for speedy reflection, for example - - @see SetHXGen module - *) -let rec is_hxgen md = - match md with - | TClassDecl cl -> Meta.has Meta.HxGen cl.cl_meta - | TEnumDecl e -> Meta.has Meta.HxGen e.e_meta - | TTypeDecl t -> Meta.has Meta.HxGen t.t_meta || ( match follow t.t_type with | TInst(cl,_) -> is_hxgen (TClassDecl cl) | TEnum(e,_) -> is_hxgen (TEnumDecl e) | _ -> false ) - | TAbstractDecl a -> Meta.has Meta.HxGen a.a_meta - -let is_hxgen_t t = - match t with - | TInst (cl, _) -> Meta.has Meta.HxGen cl.cl_meta - | TEnum (e, _) -> Meta.has Meta.HxGen e.e_meta - | TAbstract (a, _) -> Meta.has Meta.HxGen a.a_meta - | TType (t, _) -> Meta.has Meta.HxGen t.t_meta - | _ -> false - -let mt_to_t_dyn md = - match md with - | TClassDecl cl -> TInst(cl, List.map (fun _ -> t_dynamic) cl.cl_params) - | TEnumDecl e -> TEnum(e, List.map (fun _ -> t_dynamic) e.e_params) - | TAbstractDecl a -> TAbstract(a, List.map (fun _ -> t_dynamic) a.a_params) - | TTypeDecl t -> TType(t, List.map (fun _ -> t_dynamic) t.t_params) - -(* replace open TMonos with TDynamic *) -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) - -(* helper *) -let mk_class_field ?(static = false) name t public pos kind params = - let f = mk_field name ~public ~static t pos null_pos in - f.cf_meta <- [ Meta.CompilerGenerated, [], null_pos ]; (* annotate that this class field was generated by the compiler *) - f.cf_kind <- kind; - f.cf_params <- params; - f - -(* this helper just duplicates the type parameter class, which is assumed that cl is. *) -(* This is so we can use class parameters on function parameters, without running the risk of name clash *) -(* between both *) -let clone_param ttp = - let cl = ttp.ttp_class in - 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; - 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__ - -let mk_class m path pos = - let cl = Type.mk_class m path pos null_pos in - cl.cl_meta <- [ Meta.CompilerGenerated, [], null_pos ]; - cl - -type tfield_access = - | FClassField of tclass * tparams * tclass (* declared class *) * tclass_field * bool (* is static? *) * t (* the actual cf type, in relation to the class type params *) * t (* declared type *) - | FEnumField of tenum * tenum_field * bool (* is parameterized enum ? *) - | FAnonField of tclass_field - | FDynamicField of t - | FNotFound - -let is_var f = match f.cf_kind with | Var _ -> true | _ -> false - -let find_first_declared_field gen orig_cl ?get_vmtype ?exact_field field = - let get_vmtype = match get_vmtype with None -> (fun t -> t) | Some f -> f in - let chosen = ref None in - let is_overload = ref false in - let rec loop_cl depth c tl tlch = - (try - let ret = PMap.find field c.cl_fields in - if has_class_field_flag ret CfOverload then is_overload := true; - match !chosen, exact_field with - | Some(d,f,_,_,_), _ when depth <= d || (is_var ret && not (is_var f)) -> () - | _, None -> - chosen := Some(depth,ret,c,tl,tlch) - | _, Some f2 -> - List.iter (fun f -> - let declared_t = apply_params c.cl_params tl f.cf_type in - if same_overload_args ~get_vmtype declared_t f2.cf_type f f2 then - chosen := Some(depth,f,c,tl,tlch) - ) (ret :: ret.cf_overloads) - with | Not_found -> ()); - (match c.cl_super with - | Some (sup,stl) -> - let tl = List.map (apply_params c.cl_params tl) stl in - let stl = gen.greal_type_param (TClassDecl sup) stl in - let tlch = List.map (apply_params c.cl_params tlch) stl in - loop_cl (depth+1) sup tl tlch - | None -> ()); - if (has_class_flag c CInterface) then - List.iter (fun (sup,stl) -> - let tl = List.map (apply_params c.cl_params tl) stl in - let stl = gen.greal_type_param (TClassDecl sup) stl in - let tlch = List.map (apply_params c.cl_params tlch) stl in - loop_cl (depth+1) sup tl tlch - ) c.cl_implements - in - loop_cl 0 orig_cl (extract_param_types orig_cl.cl_params) (extract_param_types orig_cl.cl_params); - match !chosen with - | None -> - None - | Some(_,f,c,tl,tlch) -> - if !is_overload && not (has_class_field_flag f CfOverload) then - add_class_field_flag f CfOverload; - let declared_t = apply_params c.cl_params tl f.cf_type in - let params_t = apply_params c.cl_params tlch f.cf_type in - let actual_t = match follow params_t with - | TFun(args,ret) -> TFun(List.map (fun (n,o,t) -> (n,o,gen.greal_type t)) args, gen.greal_type ret) - | _ -> gen.greal_type params_t in - Some(f,actual_t,declared_t,params_t,c,tl,tlch) - -let rec field_access gen (t:t) (field:string) : (tfield_access) = - (* - t can be either an haxe-type as a real-type; - 'follow' should be applied here since we can generalize that a TType will be accessible as its - underlying type. - *) - - (* let pointers to values be accessed as the underlying values *) - let t = match gen.greal_type t with - | TAbstract({ a_path = ["cs"],"Pointer" },[t]) -> - gen.greal_type t - | _ -> t - in - - match follow t with - | TInst(cl, params) -> - let orig_cl = cl in - let orig_params = params in - let rec not_found cl params = - match cl.cl_dynamic with - | Some t -> - let t = apply_params cl.cl_params params t in - FDynamicField t - | None -> - match cl.cl_super with - | None -> FNotFound - | Some (super,p) -> not_found super p - in - - let not_found () = - try - let cf = PMap.find field gen.gbase_class_fields in - FClassField (orig_cl, orig_params, gen.gclasses.cl_dyn, cf, false, cf.cf_type, cf.cf_type) - with - | Not_found -> not_found cl params - in - - (* this is a hack for C#'s different generic types with same path *) - let hashtbl_field = (String.concat "" (List.map (fun _ -> "]") cl.cl_params)) ^ field in - let types = try - Hashtbl.find gen.greal_field_types (orig_cl.cl_path, hashtbl_field) - with | Not_found -> - let ret = find_first_declared_field gen cl field in - let ret = match ret with - | None -> None - | Some(cf,t,dt,_,cl,_,_) -> Some(cf,t,dt,cl) - in - if ret <> None then Hashtbl.add gen.greal_field_types (orig_cl.cl_path, hashtbl_field) ret; - ret - in - (match types with - | None -> not_found() - | Some (cf, actual_t, declared_t, declared_cl) -> - FClassField(orig_cl, orig_params, declared_cl, cf, false, actual_t, declared_t)) - | TEnum (en,params) when Meta.has Meta.Class en.e_meta -> - (* A field access to an enum could mean accessing field of its generated class (e.g. `index` for switches). - Ideally, we should change all TEnum instances to relevant TInst instances so we never reach this case, - but for now, we're going to find the generated class and make a field access to it instead. *) - (try - let cl_enum = List.find (function TClassDecl cl when cl.cl_path = en.e_path && Meta.has Meta.Enum cl.cl_meta -> true | _ -> false) gen.gtypes_list in - let cl_enum = match cl_enum with TClassDecl cl -> TInst (cl,params) | _ -> die "" __LOC__ in - field_access gen cl_enum field - with Not_found -> - FNotFound) - | TAnon anon -> - (try match !(anon.a_status) with - | ClassStatics cl -> - let cf = PMap.find field cl.cl_statics in - FClassField(cl, List.map (fun _ -> t_dynamic) cl.cl_params, cl, cf, true, cf.cf_type, cf.cf_type) - | EnumStatics e -> - let f = PMap.find field e.e_constrs in - let is_param = match follow f.ef_type with | TFun _ -> true | _ -> false in - FEnumField(e, f, is_param) - | _ when PMap.mem field gen.gbase_class_fields -> - let cf = PMap.find field gen.gbase_class_fields in - FClassField(gen.gclasses.cl_dyn, [t_dynamic], gen.gclasses.cl_dyn, cf, false, cf.cf_type, cf.cf_type) - | _ -> - FAnonField(PMap.find field anon.a_fields) - with | Not_found -> FNotFound) - | _ when PMap.mem field gen.gbase_class_fields -> - let cf = PMap.find field gen.gbase_class_fields in - FClassField(gen.gclasses.cl_dyn, [t_dynamic], gen.gclasses.cl_dyn, cf, false, cf.cf_type, cf.cf_type) - | TDynamic t -> FDynamicField (match t with None -> t_dynamic | Some t -> t) - | TMono _ -> FDynamicField t_dynamic - | _ -> FNotFound - -let field_access_esp gen t field = match field with - | FStatic(cl,cf) | FInstance(cl,_,cf) when has_class_field_flag cf CfExtern -> - let static = match field with - | FStatic _ -> true - | _ -> false - in - let p = match follow (run_follow gen t) with - | TInst(_,p) -> p - | _ -> extract_param_types cl.cl_params - in - FClassField(cl,p,cl,cf,static,cf.cf_type,cf.cf_type) - | _ -> field_access gen t (field_name field) - -let mk_field_access gen expr field pos = - match field_access gen expr.etype field with - | FClassField(c,p,dc,cf,false,at,_) -> - { eexpr = TField(expr, FInstance(dc,p,cf)); etype = apply_params c.cl_params p at; epos = pos } - | FClassField(c,p,dc,cf,true,at,_) -> - { eexpr = TField(expr, FStatic(dc,cf)); etype = at; epos = pos } - | FAnonField cf -> - { eexpr = TField(expr, FAnon cf); etype = cf.cf_type; epos = pos } - | FDynamicField t -> - { eexpr = TField(expr, FDynamic field); etype = t; epos = pos } - | FNotFound -> - { eexpr = TField(expr, FDynamic field); etype = t_dynamic; epos = pos } - | FEnumField _ -> die "" __LOC__ - -(* ******************************************* *) -(* Module dependency resolution *) -(* ******************************************* *) - -type t_dependency = - | DAfter of float - | DBefore of float - -exception ImpossibleDependency of string - -let max_dep = 10000.0 -let min_dep = - (10000.0) - -let solve_deps name (deps:t_dependency list) = - let vmin = min_dep -. 1.0 in - let vmax = max_dep +. 1.0 in - let rec loop dep vmin vmax = - match dep with - | [] -> - (if vmin >= vmax then raise (ImpossibleDependency name)); - (vmin +. vmax) /. 2.0 - | head :: tail -> - match head with - | DBefore f -> - loop tail (max vmin f) vmax - | DAfter f -> - loop tail vmin (min vmax f) - in - loop deps vmin vmax - -(* type resolution *) - -exception TypeNotFound of path - -let get_type gen path = - try Hashtbl.find gen.gtypes path with | Not_found -> raise (TypeNotFound path) - - -let fun_args l = - List.map (fun (v,s) -> (v.v_name, (s <> None), v.v_type)) l - diff --git a/src/codegen/gencommon/hardNullableSynf.ml b/src/codegen/gencommon/hardNullableSynf.ml deleted file mode 100644 index 53d94a8ccb3..00000000000 --- a/src/codegen/gencommon/hardNullableSynf.ml +++ /dev/null @@ -1,284 +0,0 @@ -(* - The Haxe Compiler - Copyright (C) 2005-2019 Haxe Foundation - - This program is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License - as published by the Free Software Foundation; either version 2 - of the License, or (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. -*) -open Option -open Common -open Type -open Gencommon - -(* ******************************************* *) -(* HardNullableSynf *) -(* ******************************************* *) -(* - This module will handle Null types for languages that offer a way of dealing with - stack-allocated structures or tuples and generics. Essentialy on those targets a Null - will be a tuple ( 'a * bool ), where bool is whether the value is null or not. - - At first (configure-time), we will modify the follow function so it can follow correctly nested Null>, - and do not follow Null to its underlying type - - Then we will run a syntax filter, which will look for casts to Null and replace them by - a call to the new Null creation; - Also casts from Null to T or direct uses of Null (call, field access, array access, closure) - will result in the actual value being accessed - For compatibility with the C# target, HardNullable will accept both Null and haxe.lang.Null types - - dependencies: - Needs to be run after all cast detection modules -*) -let name = "hard_nullable" -let priority = solve_deps name [DAfter CastDetect.ReturnCast.priority] - -let rec is_null_t gen t = match gen.greal_type t with - | TAbstract( { a_path = ([], "Null") }, [of_t]) - | TInst( { cl_path = (["haxe";"lang"], "Null") }, [of_t]) -> - let rec take_off_null t = - match is_null_t gen t with | None -> t | Some s -> take_off_null s - in - - Some (take_off_null of_t) - | TMono r -> (match r.tm_type with | Some t -> is_null_t gen t | None -> None) - | TLazy f -> is_null_t gen (lazy_type f) - | TType (t, tl) -> - is_null_t gen (apply_typedef t tl) - | _ -> None - -let follow_addon gen t = - let rec strip_off_nullable t = - let t = gen.gfollow#run_f t in - match t with - (* haxe.lang.Null> wouldn't be a valid construct, so only follow Null<> *) - | TAbstract ( { a_path = ([], "Null") }, [of_t] ) -> strip_off_nullable of_t - | _ -> t - in - - match t with - | TAbstract( ({ a_path = ([], "Null") } as tab), [of_t]) -> - Some( TAbstract(tab, [ strip_off_nullable of_t ]) ) - | _ -> None - -let configure gen unwrap_null wrap_val null_to_dynamic has_value opeq_handler = - gen.gfollow#add (name ^ "_follow") PZero (follow_addon gen); - - let is_null_t = is_null_t gen in - let is_string t = match gen.greal_type t with - | TInst({ cl_path=([],"String") },_) -> true - | _ -> false - in - let handle_unwrap to_t e = - let e_null_t = get (is_null_t e.etype) in - match gen.greal_type to_t with - | TDynamic _ | TMono _ | TAnon _ -> - (match e_null_t with - | TDynamic _ | TMono _ | TAnon _ -> - gen.ghandle_cast to_t e_null_t (unwrap_null e) - | _ -> null_to_dynamic e - ) - | _ -> - gen.ghandle_cast to_t e_null_t (unwrap_null e) - in - - let handle_wrap e t = - match e.eexpr with - | TConst(TNull) -> - wrap_val e t false - | _ -> - wrap_val e t true - in - - let cur_block = ref [] in - let add_tmp v e p = - cur_block := { eexpr = TVar(v,e); etype = gen.gcon.basic.tvoid; epos = p } :: !cur_block - in - let get_local e = match e.eexpr with - | TLocal _ -> - e, e - | _ -> - let v = mk_temp "nulltmp" e.etype in - add_tmp v (Some (null e.etype e.epos)) e.epos; - let local = { e with eexpr = TLocal(v) } in - mk_paren { e with eexpr = TBinop(Ast.OpAssign, local, e) }, local - in - let rec run e = - match e.eexpr with - | TBlock(bl) -> - let lst = !cur_block in - cur_block := []; - List.iter (fun e -> - let e = run e in - cur_block := (e :: !cur_block) - ) bl; - let ret = !cur_block in - cur_block := lst; - { e with eexpr = TBlock(List.rev ret) } - | TCast(v, _) -> - let v = match v.eexpr with - | TLocal l -> { v with etype = l.v_type } - | _ -> v - in - let null_et = is_null_t e.etype in - let null_vt = is_null_t v.etype in - (match null_vt, null_et with - | Some(vt), None when is_string e.etype -> - let v = run v in - { e with eexpr = TCast(null_to_dynamic v,None) } - | Some(vt), None -> - (match v.eexpr with - (* is there an unnecessary cast to Nullable? *) - | TCast(v2, _) -> - run { v with etype = e.etype } - | _ -> - handle_unwrap e.etype (run v) - ) - | None, Some(et) -> - handle_wrap (run v) et - | Some(vt), Some(et) when not (type_iseq (run_follow gen vt) (run_follow gen et)) -> - (* check if has value and convert *) - let vlocal_fst, vlocal = get_local (run v) in - { - eexpr = TIf( - has_value vlocal_fst, - handle_wrap (mk_cast et (unwrap_null vlocal)) et, - Some( handle_wrap (null et e.epos) et )); - etype = e.etype; - epos = e.epos - } - | _ -> - Type.map_expr run e - ) - | TField(ef, field) when is_some (is_null_t ef.etype) -> - let to_t = get (is_null_t ef.etype) in - { e with eexpr = TField(handle_unwrap to_t (run ef), field) } - | TCall(ecall, params) when is_some (is_null_t ecall.etype) -> - let to_t = get (is_null_t ecall.etype) in - { e with eexpr = TCall(handle_unwrap to_t (run ecall), List.map run params) } - | TArray(earray, p) when is_some (is_null_t earray.etype) -> - let to_t = get (is_null_t earray.etype) in - { e with eexpr = TArray(handle_unwrap to_t (run earray), p) } - | TBinop(op, e1, e2) -> - let e1_t = is_null_t e1.etype in - let e2_t = is_null_t e2.etype in - - (match op with - | Ast.OpAssign - | Ast.OpAssignOp _ -> - (match e1_t, e2_t with - | Some t1, Some t2 -> - (match op with - | Ast.OpAssign -> - Type.map_expr run e - | Ast.OpAssignOp op -> - (match e1.eexpr with - | TLocal _ -> - { e with eexpr = TBinop( Ast.OpAssign, e1, handle_wrap { e with eexpr = TBinop (op, handle_unwrap t1 e1, handle_unwrap t2 (run e2) ) } t1 ) } - | _ -> - let v, e1, evars = match e1.eexpr with - | TField(ef, f) -> - let v = mk_temp "nullbinop" ef.etype in - v, { e1 with eexpr = TField(mk_local v ef.epos, f) }, ef - | _ -> - let v = mk_temp "nullbinop" e1.etype in - v, mk_local v e1.epos, e1 - in - { e with eexpr = TBlock([ - { eexpr = TVar(v, Some evars); etype = gen.gcon.basic.tvoid; epos = e.epos }; - { e with eexpr = TBinop( Ast.OpAssign, e1, handle_wrap { e with eexpr = TBinop (op, handle_unwrap t1 e1, handle_unwrap t2 (run e2) ) } t1 ) } - ]) } - ) - | _ -> Globals.die "" __LOC__ - ) - - | _ -> - Type.map_expr run e (* casts are already dealt with normal CastDetection module *) - ) - | Ast.OpEq | Ast.OpNotEq -> - (match e1.eexpr, e2.eexpr with - | TConst(TNull), _ when is_some e2_t -> - let e = has_value (run e2) in - if op = Ast.OpEq then - { e with eexpr = TUnop(Ast.Not, Ast.Prefix, e) } - else - e - | _, TConst(TNull) when is_some e1_t -> - let e = has_value (run e1) in - if op = Ast.OpEq then - { e with eexpr = TUnop(Ast.Not, Ast.Prefix, e) } - else - e - | _ when is_some e1_t || is_some e2_t -> - let e1, e2 = - if not (is_some e1_t) then - run e2, handle_wrap (run e1) (get e2_t) - else if not (is_some e2_t) then - run e1, handle_wrap (run e2) (get e1_t) - else - run e1, run e2 - in - let e = opeq_handler e1 e2 in - if op = Ast.OpEq then - { e with eexpr = TUnop(Ast.Not, Ast.Prefix, e) } - else - e - | _ -> - Type.map_expr run e - ) - | Ast.OpAdd when is_string e1.etype || is_string e2.etype -> - let e1 = if is_some e1_t then - null_to_dynamic (run e1) - else - run e1 - in - let e2 = if is_some e2_t then - null_to_dynamic (run e2) - else - run e2 - in - let e_t = is_null_t e.etype in - if is_some e_t then - wrap_val { eexpr = TBinop(op,e1,e2); etype = get e_t; epos = e.epos } (get e_t) true - else - { e with eexpr = TBinop(op,e1,e2) } - | _ -> - let e1 = if is_some e1_t then - handle_unwrap (get e1_t) (run e1) - else run e1 in - let e2 = if is_some e2_t then - handle_unwrap (get e2_t) (run e2) - else - run e2 in - - (* if it is Null, we need to convert the result again to null *) - let e_t = (is_null_t e.etype) in - if is_some e_t then - wrap_val { eexpr = TBinop(op, e1, e2); etype = get e_t; epos = e.epos } (get e_t) true - else - { e with eexpr = TBinop(op, e1, e2) } - ) - (*| TUnop( (Ast.Increment as op)*) - | _ -> Type.map_expr run e - in - let run e = match e.eexpr with - | TFunction tf -> - run { e with eexpr = TFunction { tf with tf_expr = mk_block tf.tf_expr } } - | TBlock _ -> - run e - | _ -> match run (mk_block e) with - | { eexpr = TBlock([e]) } -> e - | e -> e - in - gen.gsyntax_filters#add name (PCustom priority) run diff --git a/src/codegen/gencommon/initFunction.ml b/src/codegen/gencommon/initFunction.ml deleted file mode 100644 index a1957b40eed..00000000000 --- a/src/codegen/gencommon/initFunction.ml +++ /dev/null @@ -1,238 +0,0 @@ -(* - The Haxe Compiler - Copyright (C) 2005-2019 Haxe Foundation - - This program is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License - as published by the Free Software Foundation; either version 2 - of the License, or (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. -*) -open Common -open Type -open Texpr.Builder -open Gencommon - -(* - This module will take proper care of the init function, by taking off all expressions from static vars and putting them - in order in the init function. - - It will also initialize dynamic functions, both by putting them in the constructor and in the init function - - depends on: - (syntax) must run before ExprStatement module - (ok) must run before OverloadingConstructor module so the constructor can be in the correct place - (syntax) must run before FunctionToClass module -*) - -let ensure_simple_expr com e = - let rec iter e = - match e.eexpr with - | TConst _ | TLocal _ | TArray _ | TBinop _ - | TField _ | TTypeExpr _ | TParenthesis _ | TCast _ | TMeta _ - | TCall _ | TNew _ | TUnop _ | TIdent _ -> - Type.iter iter e - | _ -> - print_endline (debug_expr e); - com.error "Expression is too complex for a readonly variable initialization" e.epos - in - iter e - -let handle_override_dynfun acc e this field = - let v = mk_temp ("super_" ^ field) e.etype in - add_var_flag v VCaptured; - - let add_expr = ref None in - - let rec loop e = - match e.eexpr with - | TField ({ eexpr = TConst TSuper }, f) -> - let n = field_name f in - if n <> field then Globals.die "" __LOC__; - if Option.is_none !add_expr then - add_expr := Some { e with eexpr = TVar(v, Some this) }; - mk_local v e.epos - | TConst TSuper -> Globals.die "" __LOC__ - | _ -> Type.map_expr loop e - in - let e = loop e in - - match !add_expr with - | None -> e :: acc - | Some add_expr -> add_expr :: e :: acc - -let handle_class gen cl = - let com = gen.gcon in - let init = match TClass.get_cl_init cl with - | None -> [] - | Some i -> [i] - in - let init = List.fold_left (fun acc cf -> - match cf.cf_kind with - | Var v when Meta.has Meta.ReadOnly cf.cf_meta -> - if v.v_write <> AccNever && not (Meta.has Meta.CoreApi cl.cl_meta) then gen.gwarning WGenerator "@:readOnly variable declared without `never` setter modifier" cf.cf_pos; - (match cf.cf_expr with - | None -> gen.gwarning WGenerator "Uninitialized readonly variable" cf.cf_pos - | Some e -> ensure_simple_expr gen.gcon e); - acc - | Var _ - | Method MethDynamic when Type.is_physical_field cf -> - (match cf.cf_expr with - | Some e -> - (match cf.cf_params with - | [] -> - let var = mk (TField (make_static_this cl cf.cf_pos, FStatic(cl,cf))) cf.cf_type cf.cf_pos in - let ret = binop Ast.OpAssign var e cf.cf_type cf.cf_pos in - cf.cf_expr <- None; - ret :: acc - | _ -> - let params = List.map (fun _ -> t_dynamic) cf.cf_params in - let fn = apply_params cf.cf_params params in - let var = mk (TField (make_static_this cl cf.cf_pos, FStatic(cl,cf))) (fn cf.cf_type) cf.cf_pos in - let rec change_expr e = - Type.map_expr_type change_expr fn (fun v -> v.v_type <- fn v.v_type; v) e - in - let ret = binop Ast.OpAssign var (change_expr e) (fn cf.cf_type) cf.cf_pos in - cf.cf_expr <- None; - ret :: acc) - | None -> acc) - | _ -> acc - ) init cl.cl_ordered_statics in - let init = List.rev init in - (match init with - | [] -> cl.cl_init <- None - | _ -> 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 -> - match cf.cf_kind with - | Var v when Meta.has Meta.ReadOnly cf.cf_meta -> - if v.v_write <> AccNever && not (Meta.has Meta.CoreApi cl.cl_meta) then gen.gwarning WGenerator "@:readOnly variable declared without `never` setter modifier" cf.cf_pos; - Option.may (ensure_simple_expr com) cf.cf_expr; - (acc_vars,acc_funs) - | Var _ - | Method MethDynamic -> - let is_var = match cf.cf_kind with Var _ -> true | _ -> false in - (match cf.cf_expr, cf.cf_params with - | Some e, [] -> - let var = mk (TField ((mk (TConst TThis) (TInst (cl, extract_param_types cl.cl_params)) cf.cf_pos), FInstance(cl, extract_param_types cl.cl_params, cf))) cf.cf_type cf.cf_pos in - let ret = binop Ast.OpAssign var e cf.cf_type cf.cf_pos in - cf.cf_expr <- None; - let is_override = has_class_field_flag cf CfOverride in - - if is_override then begin - cl.cl_ordered_fields <- List.filter (fun f -> f.cf_name <> cf.cf_name) cl.cl_ordered_fields; - cl.cl_fields <- PMap.remove cf.cf_name cl.cl_fields; - acc_vars, handle_override_dynfun acc_funs ret var cf.cf_name - end else if is_var then - ret :: acc_vars, acc_funs - else - acc_vars, ret :: acc_funs - | Some e, _ -> - let params = List.map (fun _ -> t_dynamic) cf.cf_params in - let fn = apply_params cf.cf_params params in - let var = mk (TField ((mk (TConst TThis) (TInst (cl, extract_param_types cl.cl_params)) cf.cf_pos), FInstance(cl, extract_param_types cl.cl_params, cf))) cf.cf_type cf.cf_pos in - let rec change_expr e = - Type.map_expr_type (change_expr) fn (fun v -> v.v_type <- fn v.v_type; v) e - in - - let ret = binop Ast.OpAssign var (change_expr e) (fn cf.cf_type) cf.cf_pos in - cf.cf_expr <- None; - let is_override = has_class_field_flag cf CfOverride in - - if is_override then begin - cl.cl_ordered_fields <- List.filter (fun f -> f.cf_name <> cf.cf_name) cl.cl_ordered_fields; - cl.cl_fields <- PMap.remove cf.cf_name cl.cl_fields; - acc_vars, handle_override_dynfun acc_funs ret var cf.cf_name - end else if is_var then - ret :: acc_vars, acc_funs - else - acc_vars, ret :: acc_funs - | None, _ -> acc_vars,acc_funs) - | _ -> acc_vars,acc_funs - ) ([],[]) cl.cl_ordered_fields - in - (* let vars = List.rev vars in *) - (* let funs = List.rev funs in *) - (* see if there is any *) - (match vars, funs with - | [], [] -> () - | _ -> - (* if there is, we need to find the constructor *) - let ctors = - match cl.cl_constructor with - | Some ctor -> - ctor - | None -> - try - let sctor, sup, stl = OverloadingConstructor.prev_ctor cl (extract_param_types cl.cl_params) in - let ctor = OverloadingConstructor.clone_ctors com sctor sup stl cl in - cl.cl_constructor <- Some ctor; - ctor - with Not_found -> - let ctor = mk_class_field "new" (TFun([], com.basic.tvoid)) false cl.cl_pos (Method MethNormal) [] in - ctor.cf_expr <- Some - { - eexpr = TFunction { - tf_args = []; - tf_type = com.basic.tvoid; - tf_expr = { eexpr = TBlock[]; etype = com.basic.tvoid; epos = cl.cl_pos }; - }; - etype = ctor.cf_type; - epos = ctor.cf_pos; - }; - cl.cl_constructor <- Some ctor; - ctor - in - let process ctor = - let func = - match ctor.cf_expr with - | Some ({ eexpr = TFunction tf } as e) -> - let rec add_fn e = - match e.eexpr with - | TBlock(hd :: tl) -> - (match hd.eexpr with - | TCall ({ eexpr = TConst TSuper }, _) -> - let tl_block = { e with eexpr = TBlock(tl) } in - if not (OverloadingConstructor.descends_from_native_or_skipctor cl) then - { e with eexpr = TBlock (vars @ (hd :: (funs @ [tl_block]))) } - else - { e with eexpr = TBlock (hd :: (vars @ funs @ [tl_block])) } - | TBlock _ -> - let tl_block = { e with eexpr = TBlock(tl) } in - { e with eexpr = TBlock ((add_fn hd) :: [tl_block]) } - | _ -> - { e with eexpr = TBlock (vars @ funs @ [{ e with eexpr = TBlock(hd :: tl) }]) }) - | _ -> - Type.concat { e with eexpr = TBlock (vars @ funs) } { e with eexpr = TBlock([e]) } - in - let tf_expr = add_fn (mk_block tf.tf_expr) in - { e with eexpr = TFunction { tf with tf_expr = tf_expr } } - | _ -> - Globals.die "" __LOC__ - in - ctor.cf_expr <- Some func - in - List.iter process (ctors :: ctors.cf_overloads) - ) - -let mod_filter gen md = - match md with - | TClassDecl cl when not (has_class_flag cl CExtern) -> - handle_class gen cl - | _ -> () - -let name = "init_funcs" -let priority = solve_deps name [DBefore OverloadingConstructor.priority] - -let configure gen = - let run = (fun md -> mod_filter gen md; md) in - gen.gmodule_filters#add name (PCustom priority) run diff --git a/src/codegen/gencommon/intDivisionSynf.ml b/src/codegen/gencommon/intDivisionSynf.ml deleted file mode 100644 index 532740e8e96..00000000000 --- a/src/codegen/gencommon/intDivisionSynf.ml +++ /dev/null @@ -1,86 +0,0 @@ -(* - The Haxe Compiler - Copyright (C) 2005-2019 Haxe Foundation - - This program is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License - as published by the Free Software Foundation; either version 2 - of the License, or (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. -*) -open Common -open Ast -open Type -open Gencommon - -(* - On targets that support int division, this module will force a float division to be performed. - It will also look for casts to int or use of Std.int() to optimize this kind of operation. - - dependencies: - since it depends on nothing, but many modules might generate division expressions, - it will be one of the last modules to run -*) -let init com = - let rec is_int e = - let rec is_int_type t = - match follow t with - | TInst ({ cl_path = (["haxe";"lang"],"Null") }, [t]) -> - is_int_type t - | t -> - like_int t && not (like_i64 t) - in - is_int_type e.etype || begin - match e.eexpr with - | TUnop (_, _, e) -> is_int e - | _ -> false - end - in - let rec is_exactly_int e = - match follow e.etype with - | TAbstract ({ a_path = ([],"Int") }, []) -> true - | _ -> - match e.eexpr with - | TUnop (_, _, e) -> is_exactly_int e - | _ -> false - in - let rec run e = - match e.eexpr with - | TBinop ((OpDiv as op), e1, e2) when is_int e1 && is_int e2 -> - { e with eexpr = TBinop (op, mk_cast com.basic.tfloat (run e1), run e2) } - | TCall ( - { eexpr = TField (_, FStatic ({ cl_path = ([], "Std") }, { cf_name = "int" })) }, - [ { eexpr = TBinop ((OpDiv as op), e1, e2) } as ebinop ] - ) when is_int e1 && is_int e2 -> - let e = { ebinop with eexpr = TBinop (op, run e1, run e2); etype = com.basic.tint } in - if not (is_exactly_int e1 && is_exactly_int e2) then - mk_cast com.basic.tint e - else - e - | TCast ({ eexpr = TBinop((OpDiv as op), e1, e2) } as ebinop, _ ) - | TCast ({ eexpr = TBinop(((OpAssignOp OpDiv) as op), e1, e2) } as ebinop, _ ) when is_int e1 && is_int e2 && is_int e -> - let ret = { ebinop with eexpr = TBinop (op, run e1, run e2); etype = e.etype } in - if not (is_exactly_int e1 && is_exactly_int e2) then - mk_cast e.etype ret - else - Type.map_expr run e - - | _ -> - Type.map_expr run e - in - run - -let name = "int_division_synf" -let priority = solve_deps name [ DAfter ExpressionUnwrap.priority; DAfter ObjectDeclMap.priority; DAfter ArrayDeclSynf.priority ] - -let configure gen = - let run = init gen.gcon in - gen.gsyntax_filters#add name (PCustom priority) run diff --git a/src/codegen/gencommon/interfaceProps.ml b/src/codegen/gencommon/interfaceProps.ml deleted file mode 100644 index 095730fdd2d..00000000000 --- a/src/codegen/gencommon/interfaceProps.ml +++ /dev/null @@ -1,43 +0,0 @@ -(* - The Haxe Compiler - Copyright (C) 2005-2019 Haxe Foundation - - This program is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License - as published by the Free Software Foundation; either version 2 - of the License, or (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. -*) -open Globals -open Type - -(* - This module filter will go through all declared properties, and see if they are conforming to a native interface. - If they are, it will add Meta.Property to it. -*) -let run = function - | TClassDecl cl when not (has_class_flag cl CInterface) && not (has_class_flag cl CExtern) -> - let vars = List.fold_left (fun acc (iface,_) -> - if Meta.has Meta.CsNative iface.cl_meta then - let props = List.filter (fun cf -> match cf.cf_kind with Var { v_read = AccCall } | Var { v_write = AccCall } -> true | _ -> false) iface.cl_ordered_fields in - props @ acc - else - acc - ) [] cl.cl_implements in - if vars <> [] then - let vars = List.map (fun cf -> cf.cf_name) vars in - List.iter (fun cf -> match cf.cf_kind with - | Var { v_read = AccCall } | Var { v_write = AccCall } when List.mem cf.cf_name vars -> - cf.cf_meta <- (Meta.Property, [], null_pos) :: cf.cf_meta - | _ -> () - ) cl.cl_ordered_fields - | _ -> - () diff --git a/src/codegen/gencommon/interfaceVarsDeleteModf.ml b/src/codegen/gencommon/interfaceVarsDeleteModf.ml deleted file mode 100644 index 9c78af2916e..00000000000 --- a/src/codegen/gencommon/interfaceVarsDeleteModf.ml +++ /dev/null @@ -1,84 +0,0 @@ -(* - The Haxe Compiler - Copyright (C) 2005-2019 Haxe Foundation - - This program is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License - as published by the Free Software Foundation; either version 2 - of the License, or (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. -*) -open Common -open Globals -open Type -open Gencommon - -(* ******************************************* *) -(* Interface Variables Removal Modf *) -(* ******************************************* *) -(* - This module filter will take care of sanitizing interfaces for targets that do not support - variables declaration in interfaces. By now this will mean that if anything is typed as the interface, - and a variable access is made, a FNotFound will be returned for the field_access, so - the field will be only accessible by reflection. - Speed-wise, ideally it would be best to create getProp/setProp functions in this case and change - the AST to call them when accessing by interface. (TODO) - But right now it will be accessed by reflection. -*) -let name = "interface_vars" -let priority = solve_deps name [] - -let configure gen = - let run md = - match md with - | TClassDecl cl when (has_class_flag cl CInterface) -> - let to_add = ref [] in - let fields = List.filter (fun cf -> - match cf.cf_kind with - | Var _ when gen.gcon.platform = Cs && Meta.has Meta.Event cf.cf_meta -> - true - | Var vkind when Type.is_physical_field cf || not (Meta.has Meta.Property cf.cf_meta) -> - (match vkind.v_read with - | AccCall -> - let newcf = mk_class_field ("get_" ^ cf.cf_name) (TFun([],cf.cf_type)) true cf.cf_pos (Method MethNormal) [] in - to_add := newcf :: !to_add; - | _ -> () - ); - (match vkind.v_write with - | AccCall -> - let newcf = mk_class_field ("set_" ^ cf.cf_name) (TFun(["val",false,cf.cf_type],cf.cf_type)) true cf.cf_pos (Method MethNormal) [] in - to_add := newcf :: !to_add; - | _ -> () - ); - cl.cl_fields <- PMap.remove cf.cf_name cl.cl_fields; - false - | Method MethDynamic -> - (* TODO OPTIMIZATION - add a `_dispatch` method to the interface which will call the dynamic function itself *) - cl.cl_fields <- PMap.remove cf.cf_name cl.cl_fields; - false - | _ -> - true - ) cl.cl_ordered_fields in - - cl.cl_ordered_fields <- fields; - - List.iter (fun cf -> - match field_access gen (TInst(cl,extract_param_types cl.cl_params)) cf.cf_name with - | FNotFound | FDynamicField _ -> - cl.cl_ordered_fields <- cf :: cl.cl_ordered_fields; - cl.cl_fields <- PMap.add cf.cf_name cf cl.cl_fields - | _ -> - () - ) !to_add - | _ -> () - in - let map md = run md; md in - gen.gmodule_filters#add name (PCustom priority) map diff --git a/src/codegen/gencommon/normalize.ml b/src/codegen/gencommon/normalize.ml deleted file mode 100644 index 5072a609734..00000000000 --- a/src/codegen/gencommon/normalize.ml +++ /dev/null @@ -1,100 +0,0 @@ -(* - The Haxe Compiler - Copyright (C) 2005-2019 Haxe Foundation - - This program is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License - as published by the Free Software Foundation; either version 2 - of the License, or (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. -*) -open Type -open Gencommon - -(* - - Filters out enum constructor type parameters from the AST; See Issue #1796 - - Filters out monomorphs - - Filters out all non-whitelisted AST metadata - - dependencies: - No dependencies; but it still should be one of the first filters to run, - as it will help normalize the AST -*) - -let rec filter_param (stack:t list) t = - match t with - | TInst({ cl_kind = KTypeParameter ttp },_) when ttp.ttp_host = TPHEnumConstructor -> - t_dynamic - | TMono r -> - (match r.tm_type with - | None -> t_dynamic - | Some t -> filter_param stack t) - | TInst(_,[]) | TEnum(_,[]) | TAbstract(_,[]) -> - t - | TType({ t_path = (["haxe";"extern"],"Rest") },_) -> - filter_param stack (follow t) - | TType(td,tl) -> - TType(td,List.map (filter_param stack) tl) - | TInst(c,tl) -> - TInst(c,List.map (filter_param stack) tl) - | TEnum(e,tl) -> - TEnum(e,List.map (filter_param stack) tl) - | TAbstract({ a_path = (["haxe"],"Rest") } as a,tl) -> - TAbstract(a, List.map (filter_param stack) tl) - | TAbstract({a_path = [],"Null"} as a,[t]) -> - TAbstract(a,[filter_param stack t]) - | TAbstract(a,tl) when (Meta.has Meta.MultiType a.a_meta) -> - filter_param stack (Abstract.get_underlying_type a tl) - | TAbstract(a,tl) -> - TAbstract(a, List.map (filter_param stack) tl) - | TAnon a -> - let fields = PMap.map (fun f -> { f with cf_type = filter_param stack f.cf_type }) a.a_fields in - mk_anon ~fields a.a_status - | TFun(args,ret) -> - TFun(List.map (fun (n,o,t) -> (n,o,filter_param stack t)) args, filter_param stack ret) - | TDynamic _ -> - t - | TLazy f -> - filter_param stack (lazy_type f) - -let filter_param t = filter_param [] t - -let init_expr_filter allowed_metas = - let rec run e = - match e.eexpr with - | TMeta ((m,_,_), e) when not (Hashtbl.mem allowed_metas m) -> - run e - | _ -> - map_expr_type (fun e -> run e) filter_param (fun v -> v.v_type <- filter_param v.v_type; v) e - in - run - -let type_filter = function - | TClassDecl cl -> - let rec map cf = - cf.cf_type <- filter_param cf.cf_type; - List.iter map cf.cf_overloads - in - List.iter map cl.cl_ordered_fields; - List.iter map cl.cl_ordered_statics; - Option.may map cl.cl_constructor - | _ -> - () - -let name = "normalize_type" -let priority = max_dep - -let configure gen ~allowed_metas = - let run = init_expr_filter allowed_metas in - gen.gexpr_filters#add name (PCustom priority) run; - - let map md = type_filter md; md in - gen.gmodule_filters#add name (PCustom priority) map diff --git a/src/codegen/gencommon/objectDeclMap.ml b/src/codegen/gencommon/objectDeclMap.ml deleted file mode 100644 index fbdfc967806..00000000000 --- a/src/codegen/gencommon/objectDeclMap.ml +++ /dev/null @@ -1,37 +0,0 @@ -(* - The Haxe Compiler - Copyright (C) 2005-2019 Haxe Foundation - - This program is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License - as published by the Free Software Foundation; either version 2 - of the License, or (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. -*) -open Type -open Gencommon - -(* ******************************************* *) -(* Object Declaration Mapper *) -(* ******************************************* *) -let name = "object_decl_map" -let priority = solve_deps name [] - -let configure gen map_fn = - let rec run e = - match e.eexpr with - | TObjectDecl odecl -> - let e = Type.map_expr run e in - (match e.eexpr with TObjectDecl odecl -> map_fn e odecl | _ -> Globals.die "" __LOC__) - | _ -> - Type.map_expr run e - in - gen.gsyntax_filters#add name (PCustom priority) run diff --git a/src/codegen/gencommon/overloadingConstructor.ml b/src/codegen/gencommon/overloadingConstructor.ml deleted file mode 100644 index 91fc5c6af5b..00000000000 --- a/src/codegen/gencommon/overloadingConstructor.ml +++ /dev/null @@ -1,458 +0,0 @@ -(* - The Haxe Compiler - Copyright (C) 2005-2019 Haxe Foundation - - This program is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License - as published by the Free Software Foundation; either version 2 - of the License, or (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. -*) -open Option -open Common -open Type -open Gencommon - -(* ******************************************* *) -(* overloading reflection constructors *) -(* ******************************************* *) -(* - this module works on languages that support function overloading and - enable function hiding via static functions. - it takes the constructor body out of the constructor and adds it to a special ctor - static function. The static function will receive the same parameters as the constructor, - plus the special "me" var, which will replace "this" - - Then it always adds two constructors to the class: one that receives a special marker class, - indicating that the object should be constructed without executing constructor body, - and one that executes its normal constructor. - Both will only include a super() call to the superclasses' emtpy constructor. - - This enables two things: - empty construction without the need of incompatibility with the platform's native construction method - the ability to call super() constructor in any place in the constructor -*) - -let rec prev_ctor c tl = - match c.cl_super with - | None -> - raise Not_found - | Some (sup,stl) -> - let stl = List.map (apply_params c.cl_params tl) stl in - match sup.cl_constructor with - | None -> prev_ctor sup stl - | Some ctor -> ctor, sup, stl - -let make_static_ctor_name cl = - let name = mk_internal_name "hx" "ctor" in - name ^ "_" ^ (String.concat "_" (fst cl.cl_path)) ^ "_" ^ (snd cl.cl_path) - -(* replaces super() call with last static constructor call *) -let replace_super_call com c tl with_params me p follow_type = - let rec loop_super c tl = - match c.cl_super with - | None -> - raise Not_found - | Some(sup,stl) -> - let stl = List.map (apply_params c.cl_params tl) stl in - try - let static_ctor_name = make_static_ctor_name sup in - sup, stl, PMap.find static_ctor_name sup.cl_statics - with Not_found -> - loop_super sup stl - in - let sup, stl, cf = loop_super c tl in - let with_params = (mk (TLocal me) me.v_type p) :: with_params in - let cf = - try - (* choose best super function *) - List.iter (fun e -> replace_mono e.etype) with_params; - List.find (fun cf -> - replace_mono cf.cf_type; - let args, _ = get_fun (apply_params cf.cf_params stl cf.cf_type) in - try - List.for_all2 (fun (_,_,t) e -> try - let e_etype = follow_type e.etype in - let t = follow_type t in - unify e_etype t; true - with Unify_error _ -> - false - ) args with_params - with Invalid_argument _ -> - false - ) (cf :: cf.cf_overloads) - with Not_found -> - com.error "No suitable overload for the super call arguments was found" p; cf - in - { - eexpr = TCall( - { - eexpr = TField(Texpr.Builder.make_static_this sup p, FStatic(sup,cf)); - etype = apply_params cf.cf_params stl cf.cf_type; - epos = p - }, - with_params - ); - etype = com.basic.tvoid; - epos = p; - } - -(* will create a static counterpart of 'ctor', and replace its contents to a call to the static version*) -let create_static_ctor com ~empty_ctor_expr cl ctor follow_type = - match Meta.has Meta.SkipCtor ctor.cf_meta with - | true -> () - | false when is_none ctor.cf_expr -> () - | false -> - let static_ctor_name = make_static_ctor_name cl in - (* create the static constructor *) - let ctor_types = List.map clone_param cl.cl_params in - let ctor_type_params = extract_param_types ctor_types in - List.iter (fun ttp -> match get_constraints ttp with - | [] -> - () - | before -> - let after = List.map (apply_params cl.cl_params ctor_type_params) before in - ttp.ttp_constraints <- Some (lazy after) - ) ctor_types; - let me = alloc_var "__hx_this" (TInst(cl, extract_param_types ctor_types)) in - add_var_flag me VCaptured; - - let fn_args, _ = get_fun ctor.cf_type in - let ctor_params = extract_param_types ctor_types in - let fn_type = TFun((me.v_name,false, me.v_type) :: List.map (fun (n,o,t) -> (n,o,apply_params cl.cl_params ctor_params t)) fn_args, com.basic.tvoid) in - let cur_tf_args = match ctor.cf_expr with - | Some { eexpr = TFunction(tf) } -> tf.tf_args - | _ -> Globals.die "" __LOC__ - in - - let changed_tf_args = List.map (fun (v,_) -> (v,None)) cur_tf_args in - - let local_map = Hashtbl.create (List.length cur_tf_args) in - let static_tf_args = (me, None) :: List.map (fun (v,b) -> - let new_v = alloc_var v.v_name (apply_params cl.cl_params ctor_params v.v_type) in - add_var_flag new_v VCaptured; - Hashtbl.add local_map v.v_id new_v; - (new_v, b) - ) cur_tf_args in - - let static_ctor = mk_class_field ~static:true static_ctor_name fn_type false ctor.cf_pos (Method MethNormal) ctor_types in - let static_ctor_meta = if has_class_flag cl CFinal then Meta.Private else Meta.Protected in - static_ctor.cf_meta <- (static_ctor_meta,[],ctor.cf_pos) :: static_ctor.cf_meta; - - (* change ctor contents to reference the 'me' var instead of 'this' *) - let actual_super_call = ref None in - let rec map_expr ~is_first e = match e.eexpr with - | TCall (({ eexpr = TConst TSuper } as tsuper), params) -> (try - let params = List.map (fun e -> map_expr ~is_first:false e) params in - actual_super_call := Some { e with eexpr = TCall(tsuper, [empty_ctor_expr]) }; - replace_super_call com cl ctor_params params me e.epos follow_type - with | Not_found -> - (* last static function was not found *) - actual_super_call := Some e; - if not is_first then - com.error "Super call must be the first call when extending native types" e.epos; - { e with eexpr = TBlock([]) }) - | TFunction tf when is_first -> - do_map ~is_first:true e - | TConst TThis -> - mk_local me e.epos - | TBlock (fst :: bl) -> - let fst = map_expr ~is_first:is_first fst in - { e with eexpr = TBlock(fst :: List.map (fun e -> map_expr ~is_first:false e) bl); etype = apply_params cl.cl_params ctor_params e.etype } - | _ -> - do_map e - and do_map ?(is_first=false) e = - let do_t = apply_params cl.cl_params ctor_params in - let do_v v = try - Hashtbl.find local_map v.v_id - with | Not_found -> - v.v_type <- do_t v.v_type; v - in - Type.map_expr_type (map_expr ~is_first:is_first) do_t do_v e - in - - let expr = do_map ~is_first:true (get ctor.cf_expr) in - let expr = match expr.eexpr with - | TFunction(tf) -> - { expr with etype = fn_type; eexpr = TFunction({ tf with tf_args = static_tf_args }) } - | _ -> Globals.die "" __LOC__ in - static_ctor.cf_expr <- Some expr; - (* add to the statics *) - (try - let stat = PMap.find static_ctor_name cl.cl_statics in - stat.cf_overloads <- static_ctor :: stat.cf_overloads - with | Not_found -> - cl.cl_ordered_statics <- static_ctor :: cl.cl_ordered_statics; - cl.cl_statics <- PMap.add static_ctor_name static_ctor cl.cl_statics); - (* change current super call *) - match ctor.cf_expr with - | Some({ eexpr = TFunction(tf) } as e) -> - let block_contents, p = match !actual_super_call with - | None -> [], ctor.cf_pos - | Some super -> [super], super.epos - in - let el_args = - let rec loop fn_args cur_args = - match cur_args with - | [] -> [] - | (v,_) :: cur_args -> - let local = mk_local v p in - match fn_args, cur_args with - | [_,_,t], [] when ExtType.is_rest (follow t) -> - [mk (TUnop(Spread,Prefix,local)) v.v_type p] - | [], _ -> - local :: loop fn_args cur_args - | _ :: fn_args, _ -> - local :: loop fn_args cur_args - in - loop fn_args cur_tf_args - in - let block_contents = block_contents @ [{ - eexpr = TCall( - { - eexpr = TField( - Texpr.Builder.make_static_this cl p, - FStatic(cl, static_ctor)); - etype = apply_params static_ctor.cf_params (extract_param_types cl.cl_params) static_ctor.cf_type; - epos = p - }, - [{ eexpr = TConst TThis; etype = TInst(cl, extract_param_types cl.cl_params); epos = p }] - @ el_args - ); - etype = com.basic.tvoid; - epos = p - }] in - ctor.cf_expr <- Some { e with eexpr = TFunction({ tf with tf_expr = { tf.tf_expr with eexpr = TBlock block_contents }; tf_args = changed_tf_args }) } - | _ -> Globals.die "" __LOC__ - -(* makes constructors that only call super() for the 'ctor' argument *) -let clone_ctors com ctor sup stl cl = - let clone cf = - let ncf = mk_class_field "new" (apply_params sup.cl_params stl cf.cf_type) (has_class_field_flag cf CfPublic) cf.cf_pos cf.cf_kind cf.cf_params in - if Meta.has Meta.Protected cf.cf_meta then - ncf.cf_meta <- (Meta.Protected,[],ncf.cf_pos) :: ncf.cf_meta; - let args, ret = get_fun ncf.cf_type in - (* single expression: call to super() *) - let tf_args = List.map (fun (name,_,t) -> - (* the constructor will have no optional arguments, as presumably this will be handled by the underlying expr *) - alloc_var name t, None - ) args in - let super_call = - { - eexpr = TCall( - { eexpr = TConst TSuper; etype = TInst(cl, extract_param_types cl.cl_params); epos = ctor.cf_pos }, - List.map (fun (v,_) -> mk_local v ctor.cf_pos) tf_args); - etype = com.basic.tvoid; - epos = ctor.cf_pos; - } in - ncf.cf_expr <- Some - { - eexpr = TFunction { - tf_args = tf_args; - tf_type = com.basic.tvoid; - tf_expr = mk_block super_call; - }; - etype = ncf.cf_type; - epos = ctor.cf_pos; - }; - ncf - in - (* take off createEmpty *) - let all = List.filter (fun cf -> replace_mono cf.cf_type; not (Meta.has Meta.SkipCtor cf.cf_meta)) (ctor :: ctor.cf_overloads) in - let clones = List.map clone all in - match clones with - | [] -> - (* raise Not_found *) - Globals.die "" __LOC__ (* should never happen *) - | cf :: [] -> cf - | cf :: overl -> - add_class_field_flag cf CfOverload; - cf.cf_overloads <- overl; cf - -let rec descends_from_native_or_skipctor cl = - not (is_hxgen (TClassDecl cl)) || Meta.has Meta.SkipCtor cl.cl_meta || match cl.cl_super with - | None -> false - | Some(c,_) -> descends_from_native_or_skipctor c - -let ensure_super_is_first com cf = - let rec loop e = - match e.eexpr with - | TBlock (b :: block) -> - loop b - | TBlock [] - | TCall({ eexpr = TConst TSuper },_) -> () - | _ -> - com.error "Types that derive from a native class must have its super() call as the first statement in the constructor" cf.cf_pos - in - match cf.cf_expr with - | None -> () - | Some e -> Type.iter loop e - -let init com (empty_ctor_type : t) (empty_ctor_expr : texpr) (follow_type : t -> t) = - let basic = com.basic in - let should_change cl = not (has_class_flag cl CInterface) && (not (has_class_flag cl CExtern) || is_hxgen (TClassDecl cl)) && (match cl.cl_kind with KAbstractImpl _ | KModuleFields _ -> false | _ -> true) in - let msize = List.length com.types in - let processed, empty_ctors = Hashtbl.create msize, Hashtbl.create msize in - - let rec get_last_empty cl = - try - Hashtbl.find empty_ctors cl.cl_path - with | Not_found -> - match cl.cl_super with - | None -> raise Not_found - | Some (sup,_) -> get_last_empty sup - in - - let rec change cl = - if not (Hashtbl.mem processed cl.cl_path) then begin - Hashtbl.add processed cl.cl_path true; - - (* make sure we've processed the super types *) - Option.may (fun (super,_) -> if should_change super then change super) cl.cl_super; - - (* implement static hx_ctor and reimplement constructors *) - (try - let ctor = - match cl.cl_constructor with - | Some ctor -> - ctor - | None -> - try - let sctor, sup, stl = prev_ctor cl (extract_param_types cl.cl_params) in - (* we'll make constructors that will only call super() *) - let ctor = clone_ctors com sctor sup stl cl in - cl.cl_constructor <- Some ctor; - ctor - with Not_found -> (* create default constructor *) - let ctor = mk_class_field "new" (TFun ([], basic.tvoid)) false cl.cl_pos (Method MethNormal) [] in - ctor.cf_expr <- Some { - eexpr = TFunction { - tf_args = []; - tf_type = basic.tvoid; - tf_expr = mk (TBlock []) basic.tvoid cl.cl_pos; - }; - etype = ctor.cf_type; - epos = ctor.cf_pos; - }; - cl.cl_constructor <- Some ctor; - ctor - in - - let has_super_constructor = - match cl.cl_super with - | None -> false - | Some (csup,_) -> has_constructor csup - in - - (* now that we made sure we have a constructor, exit if native gen *) - if not (is_hxgen (TClassDecl cl)) || Meta.has Meta.SkipCtor cl.cl_meta then begin - if descends_from_native_or_skipctor cl && has_super_constructor then - List.iter (fun cf -> ensure_super_is_first com cf) (ctor :: ctor.cf_overloads); - raise Exit - end; - - (* if cl descends from a native class, we cannot use the static constructor strategy *) - if descends_from_native_or_skipctor cl && has_super_constructor then - List.iter (fun cf -> ensure_super_is_first com cf) (ctor :: ctor.cf_overloads) - else - (* now that we have a current ctor, create the static counterparts *) - List.iter (fun cf -> create_static_ctor com ~empty_ctor_expr:empty_ctor_expr cl cf follow_type) (ctor :: ctor.cf_overloads) - with Exit -> ()); - - (* implement empty ctor *) - (try - (* now that we made sure we have a constructor, exit if native gen *) - if not (is_hxgen (TClassDecl cl)) then raise Exit; - - (* get first *) - let empty_type = TFun (["empty",false,empty_ctor_type],basic.tvoid) in - let super = - match cl.cl_super with - | None -> (* implement empty *) - [] - | Some (sup,_) -> - try - ignore (get_last_empty sup); - let esuper = mk (TConst TSuper) (TInst (cl, extract_param_types cl.cl_params)) cl.cl_pos in - [mk (TCall (esuper, [empty_ctor_expr])) basic.tvoid cl.cl_pos] - with Not_found -> - try - (* super type is native: find super constructor with least arguments *) - let sctor, sup, stl = prev_ctor cl (extract_param_types cl.cl_params) in - let rec loop remaining (best,n) = - match remaining with - | [] -> best - | cf :: r -> - let args,_ = get_fun cf.cf_type in - if (List.length args) < n then - loop r (cf,List.length args) - else - loop r (best,n) - in - let args,_ = get_fun sctor.cf_type in - let best = loop sctor.cf_overloads (sctor, List.length args) in - let args,_ = get_fun (apply_params sup.cl_params stl best.cf_type) in - let esuper = mk (TConst TSuper) (TInst (sup, stl)) cl.cl_pos in - [mk (TCall (esuper, List.map (fun (n,o,t) -> null t cl.cl_pos) args)) basic.tvoid cl.cl_pos] - with Not_found -> - (* extends native type, but no ctor found *) - [] - in - let ctor = mk_class_field "new" empty_type false cl.cl_pos (Method MethNormal) [] in - ctor.cf_expr <- Some { - eexpr = TFunction { - tf_type = basic.tvoid; - tf_args = [alloc_var "empty" empty_ctor_type, None]; - tf_expr = mk (TBlock super) basic.tvoid cl.cl_pos - }; - etype = empty_type; - epos = cl.cl_pos; - }; - ctor.cf_meta <- [Meta.SkipCtor, [], ctor.cf_pos]; - Hashtbl.add empty_ctors cl.cl_path ctor; - match cl.cl_constructor with - | None -> - cl.cl_constructor <- Some ctor - | Some c -> - c.cf_overloads <- ctor :: c.cf_overloads - with Exit -> ()); - end - in - - let module_filter md = - (match md with - | TClassDecl cl when should_change cl -> - change cl; - | _ -> - ()); - md - in - module_filter - -let init_expr_filter create_empty = - let rec run e = - match e.etype, e.eexpr with - | TInst (cl, params), TCall ({ eexpr = TField (_, FStatic ({cl_path = [],"Type"}, {cf_name = "createEmptyInstance"})) }, [{eexpr = TTypeExpr ((TClassDecl cl_arg) as mt_arg) }]) when cl == cl_arg && is_hxgen mt_arg -> - create_empty cl params e.epos - | _ -> - Type.map_expr run e - in - run - -let priority = 0.0 -let name = "overloading_constructor" - -let configure gen ~empty_ctor_type ~empty_ctor_expr = - gen.gtools.r_create_empty <- (fun cl params pos -> mk (TNew(cl,params,[empty_ctor_expr])) (TInst(cl,params)) pos); - let module_filter = init gen.gcon empty_ctor_type empty_ctor_expr (run_follow gen) in - gen.gmodule_filters#add name (PCustom priority) module_filter; - let expr_filter = init_expr_filter gen.gtools.r_create_empty in - gen.gexpr_filters#add name (PCustom priority) expr_filter diff --git a/src/codegen/gencommon/realTypeParams.ml b/src/codegen/gencommon/realTypeParams.ml deleted file mode 100644 index 5ed9d19c339..00000000000 --- a/src/codegen/gencommon/realTypeParams.ml +++ /dev/null @@ -1,786 +0,0 @@ -(* - The Haxe Compiler - Copyright (C) 2005-2019 Haxe Foundation - - This program is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License - as published by the Free Software Foundation; either version 2 - of the License, or (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. -*) -open Option -open Common -open Ast -open Type -open Texpr.Builder -open Gencommon - -(* ******************************************* *) -(* Type Parameters *) -(* ******************************************* *) -(* - This module will handle type parameters. There are lots of changes we need to do to correctly support type parameters: - - traverse will: - V Detect when parameterized function calls are made - * Detect when a parameterized class instance is being cast to another parameter - * Change new<> parameterized function calls - * - - extras: - * On languages that support "real" type parameters, a Cast function is provided that will convert from a to the requested type. - This cast will call createEmpty with the correct type, and then set each variable to the new form. Some types will be handled specially, namely the Native Array. - Other implementations may be delegated to the runtime. - * parameterized classes will implement a new interface (with only a Cast<> function added to it), so we can access the type parameter for them. Also any reference to will be replaced by a reference to this interface. (also on TTypeExpr - Std.is()) - * Type parameter renaming to avoid name clash - * Detect type parameter casting and call Cast<> instead - - for java: - * for specially assigned classes, parameters will be replaced by _d and _i versions of parameterized functions. This will only work for parameterized classes, not functions. - - dependencies: - must run after casts are detected. This will be ensured at CastDetect module. -*) -(* ******************************************* *) -(* Real Type Parameters Module *) -(* ******************************************* *) -(* - This submodule is by now specially made for the .NET platform. There might be other targets that will - make use of this, but it IS very specific. - - On the .NET platform, generics are real specialized classes that are JIT compiled. For this reason, we cannot - cast from one type parameter to another. Also there is no common type for the type parameters, so for example - an instance of type Array will return false for instance is Array . - - So we need to: - 1. create a common interface (without type parameters) (e.g. "Array") which will only contain a __Cast<> function, which will cast from one type into another - 2. Implement the __Cast function. This part is a little hard, as we must identify all type parameter-dependent fields contained in the class and convert them. - In most cases the conversion will just be to call .__Cast<>() on the instances, or just a simple cast. But when the instance is a @:nativegen type, there will be no .__Cast - function, and we will need to deal with this case either at compile-time (added handlers - specially for NativeArray), or at runtime (adding new runtime handlers) - 3. traverse the AST looking for casts involving type parameters, and replace them with .__Cast<>() calls. If type is @:nativegen, throw a warning. If really casting from one type parameter to another on a @:nativegen context, throw an error. - - - special literals: - it will use the special literal __typehandle__ that the target must implement in order to run this. This literal is a way to get the typehandle of e.g. the type parameters, - so we can compare them. In C# it's the equivalent of typeof(T).TypeHandle (TypeHandle compare is faster than System.Type.Equals()) - - dependencies: - (module filter) Interface creation must run AFTER enums are converted into classes, otherwise there is no way to tell parameterized enums to implement an interface - Must run AFTER CastDetect. This will be ensured per CastDetect - -*) -let name = "real_type_params" -let priority = max_dep -. 20. - -let rec has_type_params t = - match follow t with - | TInst( { cl_kind = KTypeParameter _ }, _) -> true - | TAbstract(_, params) - | TEnum(_, params) - | TInst(_, params) -> List.exists (fun t -> has_type_params t) params - | TFun(args,ret) -> - List.exists (fun (n,o,t) -> has_type_params t) args || has_type_params ret - | _ -> false - -let follow_all_md md = - let t = match md with - | TClassDecl { cl_kind = KAbstractImpl a } -> - TAbstract(a, extract_param_types a.a_params) - | TClassDecl c -> - TInst(c, extract_param_types c.cl_params) - | TEnumDecl e -> - TEnum(e, extract_param_types e.e_params) - | TTypeDecl t -> - TType(t, extract_param_types t.t_params) - | TAbstractDecl a -> - TAbstract(a, extract_param_types a.a_params) - in - Abstract.follow_with_abstracts t - -let rec is_hxgeneric md = - match md with - | TClassDecl { cl_kind = KAbstractImpl a } -> - is_hxgeneric (TAbstractDecl a) - | TClassDecl(cl) -> - not (Meta.has Meta.NativeGeneric cl.cl_meta) - | TEnumDecl(e) -> - not (Meta.has Meta.NativeGeneric e.e_meta) - | TAbstractDecl(a) when Meta.has Meta.NativeGeneric a.a_meta -> - not (Meta.has Meta.NativeGeneric a.a_meta) - | md -> match follow_all_md md with - | TInst(cl,_) -> is_hxgeneric (TClassDecl cl) - | TEnum(e,_) -> is_hxgeneric (TEnumDecl e) - | TAbstract(a,_) -> not (Meta.has Meta.NativeGeneric a.a_meta) - | _ -> true - -type nativegeneric_reason = - | ReasonField of string * Type.t - | ReasonSuper of Globals.path - | ReasonExplicit - -exception Cannot_be_native of Globals.path * pos * Globals.path * nativegeneric_reason - -let rec set_hxgeneric gen mds isfirst md = - let iface_path, raise_pos, raise_if_native = match md with - | TClassDecl(cl) -> (try - (fst (List.find (fun (cl,_) -> (set_hxgeneric gen mds isfirst (TClassDecl cl) ) = Some(true) ) cl.cl_implements)).cl_path, cl.cl_pos, true - with Not_found -> - ([],""), Globals.null_pos, false) - | _ -> ([],""), Globals.null_pos, false - in - let path = t_path md in - if List.exists (fun m -> path = t_path m) mds then begin - if isfirst then - None (* we still can't determine *) - else - Some true (* if we're in second pass and still can't determine, it's because it can be hxgeneric *) - end else begin - let has_unresolved = ref false in - let is_false v = - match v with - | Some false -> true - | None -> has_unresolved := true; false - | Some true -> false - in - let mds = md :: mds in - match md with - | TClassDecl(cl) -> - (* first see if any meta is present (already processed) *) - if Meta.has Meta.NativeGeneric cl.cl_meta then begin - if raise_if_native then raise (Cannot_be_native(path, raise_pos, iface_path, ReasonExplicit)); - Some false - end else if Meta.has Meta.HaxeGeneric cl.cl_meta then - Some true - else if cl.cl_params = [] && is_hxgen md then - (cl.cl_meta <- (Meta.HaxeGeneric,[],cl.cl_pos) :: cl.cl_meta; - Some true) - else if cl.cl_params = [] then - (cl.cl_meta <- (Meta.NativeGeneric, [], cl.cl_pos) :: cl.cl_meta; - Some false) - else if not (is_hxgen md) then - (cl.cl_meta <- (Meta.NativeGeneric, [], cl.cl_pos) :: cl.cl_meta; - Some false) - else begin - (* - if it's not present, see if any superclass is nativegeneric. - nativegeneric is inherited, while hxgeneric can be later changed to nativegeneric - *) - (* on the first pass, our job is to find any evidence that makes it not be hxgeneric. Otherwise it will be hxgeneric *) - match cl.cl_super with - | Some (c,_) when is_false (set_hxgeneric gen mds isfirst (TClassDecl c)) -> - if raise_if_native then raise (Cannot_be_native(path, raise_pos, iface_path, ReasonSuper(c.cl_path))); - cl.cl_meta <- (Meta.NativeGeneric, [], cl.cl_pos) :: cl.cl_meta; - Some false - | _ -> - (* see if it's a generic class *) - match cl.cl_params with - | [] -> - (* if it's not, then it will follow hxgen *) - if is_hxgen (TClassDecl cl) then - cl.cl_meta <- (Meta.HaxeGeneric, [], cl.cl_pos) :: cl.cl_meta - else - cl.cl_meta <- (Meta.NativeGeneric, [], cl.cl_pos) :: cl.cl_meta; - Some true - | _ -> - (* if it is, loop through all fields + statics and look for non-hxgeneric - generic classes that have KTypeParameter as params *) - let raise_or_return_true = if raise_if_native then - (fun cf -> raise (Cannot_be_native(path, raise_pos, iface_path, ReasonField(cf.cf_name, cf.cf_type)))) - else - (fun cf -> true) - in - let rec cfs_must_be_native cfs = - match cfs with - | [] -> false - | cf :: cfs when Type.is_physical_field cf -> - let t = follow (gen.greal_type cf.cf_type) in - (match t with - | TInst( { cl_kind = KTypeParameter _ }, _ ) -> cfs_must_be_native cfs - | TInst(cl,p) when has_type_params t && is_false (set_hxgeneric gen mds isfirst (TClassDecl cl)) -> - if not (Hashtbl.mem gen.gtparam_cast cl.cl_path) then raise_or_return_true cf else cfs_must_be_native cfs - | TEnum(e,p) when has_type_params t && is_false (set_hxgeneric gen mds isfirst (TEnumDecl e)) -> - if not (Hashtbl.mem gen.gtparam_cast e.e_path) then raise_or_return_true cf else cfs_must_be_native cfs - | _ -> cfs_must_be_native cfs (* TAbstracts / Dynamics can't be generic *) - ) - | _ :: cfs -> - cfs_must_be_native cfs - in - if cfs_must_be_native cl.cl_ordered_fields then begin - cl.cl_meta <- (Meta.NativeGeneric, [], cl.cl_pos) :: cl.cl_meta; - Some false - end else if isfirst && !has_unresolved then - None - else begin - cl.cl_meta <- (Meta.HaxeGeneric, [], cl.cl_pos) :: cl.cl_meta; - Some true - end - end - | TEnumDecl e -> - if Meta.has Meta.NativeGeneric e.e_meta then begin - if raise_if_native then raise (Cannot_be_native(path, raise_pos, iface_path, ReasonExplicit)); - Some false - end else if Meta.has Meta.HaxeGeneric e.e_meta then - Some true - else if not (is_hxgen (TEnumDecl e)) then begin - e.e_meta <- (Meta.NativeGeneric, [], e.e_pos) :: e.e_meta; - Some false - end else begin - (* if enum is not generic, then it's hxgeneric *) - match e.e_params with - | [] -> - e.e_meta <- (Meta.HaxeGeneric, [], e.e_pos) :: e.e_meta; - Some true - | _ -> - let raise_or_return_true = if raise_if_native then - (fun name t -> raise (Cannot_be_native(path, raise_pos, iface_path, ReasonField(name, t)))) - else - (fun _ _ -> true) - in - let rec efs_must_be_native efs = - match efs with - | [] -> false - | ef :: efs -> - let t = follow (gen.greal_type ef.ef_type) in - match t with - | TFun(args, _) -> - if List.exists (fun (n,o,t) -> - let t = follow t in - match t with - | TInst( { cl_kind = KTypeParameter _ }, _ ) -> - false - | TInst(cl,p) when has_type_params t && is_false (set_hxgeneric gen mds isfirst (TClassDecl cl)) -> - if not (Hashtbl.mem gen.gtparam_cast cl.cl_path) then raise_or_return_true ef.ef_name t else false - | TEnum(e,p) when has_type_params t && is_false (set_hxgeneric gen mds isfirst (TEnumDecl e)) -> - if not (Hashtbl.mem gen.gtparam_cast e.e_path) then raise_or_return_true ef.ef_name t else false - | _ -> false - ) args then - true - else - efs_must_be_native efs - | _ -> efs_must_be_native efs - in - let efs = PMap.fold (fun ef acc -> ef :: acc) e.e_constrs [] in - if efs_must_be_native efs then begin - e.e_meta <- (Meta.NativeGeneric, [], e.e_pos) :: e.e_meta; - Some false - end else if isfirst && !has_unresolved then - None - else begin - e.e_meta <- (Meta.HaxeGeneric, [], e.e_pos) :: e.e_meta; - Some true - end - end - | _ -> Globals.die "" __LOC__ - end - -let path_s = function - | [],name -> name - | pack,name -> String.concat "." pack ^ "." ^ name - -let set_hxgeneric gen md = - try - let ret = match md with - | TClassDecl { cl_kind = KAbstractImpl a } -> (match follow_all_md md with - | (TInst _ | TEnum _ as t) -> ( - let md = match t with - | TInst(cl,_) -> TClassDecl cl - | TEnum(e,_) -> TEnumDecl e - | _ -> Globals.die "" __LOC__ - in - let ret = set_hxgeneric gen [] true md in - if ret = None then get (set_hxgeneric gen [] false md) else get ret) - | TAbstract(a,_) -> true - | _ -> true) - | _ -> match set_hxgeneric gen [] true md with - | None -> - get (set_hxgeneric gen [] false md) - | Some v -> - v - in - if not ret then begin - match md with - | TClassDecl c -> - let set_hxgeneric tp = - let c = tp.ttp_class in - c.cl_meta <- (Meta.NativeGeneric, [], c.cl_pos) :: c.cl_meta - in - List.iter set_hxgeneric c.cl_params; - let rec handle_field cf = - List.iter set_hxgeneric cf.cf_params; - List.iter handle_field cf.cf_overloads - in - (match c.cl_kind with - | KAbstractImpl a -> - List.iter set_hxgeneric a.a_params; - | _ -> ()); - List.iter handle_field c.cl_ordered_fields; - List.iter handle_field c.cl_ordered_statics - | _ -> () - end; - ret - with Cannot_be_native(path, pos, iface_path, reason) -> - let reason_start = "The class at path " ^ path_s path ^ " implements a haxe generic interface " ^ path_s iface_path - ^ ". It however cannot be a haxe generic class " - in - let reason = reason_start ^ match reason with - | ReasonField (field_name, t) -> - "because its field " ^ field_name ^ " is of type " ^ debug_type t - | ReasonSuper (path) -> - "because it extends the type " ^ path_s path ^ " that was determined to be a native generic type" - | ReasonExplicit -> - "because it explicitly has the metadata @:nativeGeneric set" - in - gen.gcon.error (reason) pos; - Globals.die "" __LOC__ - -let params_has_tparams params = - List.fold_left (fun acc t -> acc || has_type_params t) false params - -(* ******************************************* *) -(* RealTypeParamsModf *) -(* ******************************************* *) - -(* - - This is the module filter of Real Type Parameters. It will traverse through all types and look for hxgeneric classes (only classes). - When found, a parameterless interface will be created and associated via the "ifaces" Hashtbl to the original class. - Also a "cast" function will be automatically generated which will handle unsafe downcasts to more specific type parameters (necessary for serialization) - - dependencies: - Anything that may create hxgeneric classes must run before it. - Should run before ReflectionCFs (this dependency will be added to ReflectionCFs), so the added interfaces also get to be real IHxObject's - -*) - -module RealTypeParamsModf = -struct - - let set_only_hxgeneric gen = - let run md = - match md with - | TTypeDecl _ | TAbstractDecl _ -> md - | _ -> ignore (set_hxgeneric gen md); md - in - run - - let name = "real_type_params_modf" - - let priority = solve_deps name [] - - let rec get_fields gen cl params_cl params_cf acc = - let fields = List.fold_left (fun acc cf -> - match follow (gen.greal_type (gen.gfollow#run_f (cf.cf_type))) with - | TInst(cli, ((_ :: _) as p)) when (not (is_hxgeneric (TClassDecl cli))) && params_has_tparams p -> - (cf, apply_params cl.cl_params params_cl cf.cf_type, apply_params cl.cl_params params_cf cf.cf_type) :: acc - | TEnum(e, ((_ :: _) as p)) when not (is_hxgeneric (TEnumDecl e)) && params_has_tparams p -> - (cf, apply_params cl.cl_params params_cl cf.cf_type, apply_params cl.cl_params params_cf cf.cf_type) :: acc - | _ -> acc - ) [] cl.cl_ordered_fields in - match cl.cl_super with - | Some(cs, tls) -> - get_fields gen cs (List.map (apply_params cl.cl_params params_cl) tls) (List.map (apply_params cl.cl_params params_cf) tls) (fields @ acc) - | None -> (fields @ acc) - - let get_cast_name cl = String.concat "_" ((fst cl.cl_path) @ [snd cl.cl_path; "cast"]) (* explicitly define it *) - - (* overrides all needed cast functions from super classes / interfaces to call the new cast function *) - let create_stub_casts gen cl cast_cfield = - (* go through superclasses and interfaces *) - let p = cl.cl_pos in - let this = { eexpr = TConst TThis; etype = (TInst(cl, extract_param_types cl.cl_params)); epos = p } in - - let rec loop curcls params level reverse_params = - if (level <> 0 || (has_class_flag curcls CInterface) || (has_class_flag curcls CAbstract) ) && params <> [] && is_hxgeneric (TClassDecl curcls) then begin - let cparams = List.map clone_param curcls.cl_params in - let name = get_cast_name curcls in - if not (PMap.mem name cl.cl_fields) then begin - let reverse_params = List.map (apply_params curcls.cl_params params) reverse_params in - let cfield = mk_class_field name (TFun([], t_dynamic)) false cl.cl_pos (Method MethNormal) cparams in - let field = { eexpr = TField(this, FInstance(cl,extract_param_types cl.cl_params, cast_cfield)); etype = apply_params cast_cfield.cf_params reverse_params cast_cfield.cf_type; epos = p } in - let call = - { - eexpr = TCall(field, []); - etype = t_dynamic; - epos = p; - } in - let call = gen.gparam_func_call call field reverse_params [] in - let delay () = - cfield.cf_expr <- - Some { - eexpr = TFunction( - { - tf_args = []; - tf_type = t_dynamic; - tf_expr = mk_return call - }); - etype = cfield.cf_type; - epos = p; - } - in - gen.gafter_filters_ended <- delay :: gen.gafter_filters_ended; (* do not let filters alter this expression content *) - cl.cl_ordered_fields <- cfield :: cl.cl_ordered_fields; - cl.cl_fields <- PMap.add cfield.cf_name cfield cl.cl_fields; - if level <> 0 then add_class_field_flag cfield CfOverride - end - end; - let get_reverse super supertl = - List.map (apply_params super.cl_params supertl) reverse_params - in - (match curcls.cl_super with - | None -> () - | Some(super, supertl) -> - let super_params = List.map (apply_params curcls.cl_params params) supertl in - loop super (super_params) (level + 1) (get_reverse super super_params)); - List.iter (fun (iface, ifacetl) -> - let iface_params = List.map (apply_params curcls.cl_params params) ifacetl in - loop iface (iface_params) level (get_reverse iface iface_params); - ) curcls.cl_implements - in - loop cl (extract_param_types cl.cl_params) 0 (extract_param_types cl.cl_params) - - (* - Creates a cast classfield, with the desired name - - Will also look for previous cast() definitions and override them, to reflect the current type and fields - - FIXME: this function still doesn't support generics that extend generics, and are cast as one of its subclasses. This needs to be taken care, by - looking at previous superclasses and whenever a generic class is found, its cast argument must be overridden. the toughest part is to know how to type - the current type correctly. - *) - let create_cast_cfield gen cl name = - reset_temps(); - let basic = gen.gcon.basic in - let cparams = List.map clone_param cl.cl_params in - let cfield = mk_class_field name (TFun([], t_dynamic)) false cl.cl_pos (Method MethNormal) cparams in - let params = extract_param_types cparams in - - let fields = get_fields gen cl (extract_param_types cl.cl_params) params [] in - let fields = List.filter (fun (cf,_,_) -> Type.is_physical_field cf) fields in - - (* now create the contents of the function *) - (* - it will look something like: - if (typeof(T) == typeof(T2)) return this; - - var new_me = new CurrentClass(EmptyInstnace); - - for (field in Reflect.fields(this)) - { - switch(field) - { - case "aNativeArray": - var newArray = new NativeArray(this.aNativeArray.Length); - - default: - Reflect.setField(new_me, field, Reflect.field(this, field)); - } - } - *) - let pos = cl.cl_pos in - - let new_me_var = alloc_var "new_me" (TInst (cl, params)) in - let local_new_me = mk_local new_me_var pos in - let this = mk (TConst TThis) (TInst (cl, extract_param_types cl.cl_params)) pos in - let field_var = alloc_var "field" basic.tstring in - let local_field = mk_local field_var pos in - let i_var = alloc_var "i" basic.tint in - let local_i = mk_local i_var pos in - let incr_i = mk (TUnop (Increment, Postfix, local_i)) basic.tint pos in - let fields_var = alloc_var "fields" (basic.tarray basic.tstring) in - let local_fields = mk_local fields_var pos in - - let fields_to_cases fields = - let get_path t = - match follow t with - | TInst (cl,_) -> cl.cl_path - | TEnum (e,_) -> e.e_path - | TAbstract (a,_) -> a.a_path - | TMono _ | TDynamic _ -> ([], "Dynamic") - | _ -> Globals.die "" __LOC__ - in - List.map (fun (cf, t_cl, t_cf) -> - let t_cf = follow (gen.greal_type t_cf) in - let this_field = mk (TField (this, FInstance (cl, extract_param_types cl.cl_params, cf))) t_cl pos in - let expr = - binop - OpAssign - (mk (TField (local_new_me, FInstance(cl, extract_param_types cl.cl_params, cf))) t_cf pos) - (try (Hashtbl.find gen.gtparam_cast (get_path t_cf)) this_field t_cf with Not_found -> - (* if not found tparam cast, it shouldn't be a valid hxgeneric *) - print_endline ("Could not find a gtparam_cast for " ^ (String.concat "." (fst (get_path t_cf)) ^ "." ^ (snd (get_path t_cf)))); - Globals.die "" __LOC__) - t_cf - pos - in - { - case_patterns = [make_string gen.gcon.basic cf.cf_name pos]; - case_expr = expr; - } - ) fields - in - - let mk_typehandle = - (fun cl -> mk (TCall (mk (TIdent "__typeof__") t_dynamic pos, [make_static_this cl pos])) t_dynamic pos) - in - let mk_eq cl1 cl2 = - binop OpEq (mk_typehandle cl1) (mk_typehandle cl2) basic.tbool pos - in - let rec mk_typehandle_cond thisparams cfparams = - match thisparams, cfparams with - | TInst (cl_this,[]) :: [], TInst (cl_cf,[]) :: [] -> - mk_eq cl_this cl_cf - | TInst (cl_this,[]) :: hd, TInst (cl_cf,[]) :: hd2 -> - binop OpBoolAnd (mk_eq cl_this cl_cf) (mk_typehandle_cond hd hd2) basic.tbool pos - | v :: hd, v2 :: hd2 -> - (match follow v, follow v2 with - | (TInst(cl1,[]) as v), (TInst(cl2,[]) as v2) -> - mk_typehandle_cond (v :: hd) (v2 :: hd2) - | _ -> - Globals.die "" __LOC__) - | _ -> Globals.die "" __LOC__ - in - let fn = { - tf_args = []; - tf_type = t_dynamic; - tf_expr = mk (TBlock [ - (* if (typeof(T) == typeof(T2)) return this *) - mk (TIf (mk_typehandle_cond (extract_param_types cl.cl_params) params, mk_return this, None)) basic.tvoid pos; - (* var new_me = /*special create empty with tparams construct*/ *) - mk (TVar (new_me_var, Some (gen.gtools.r_create_empty cl params pos))) basic.tvoid pos; - (* var fields = Reflect.fields(this); *) - mk (TVar (fields_var, Some (gen.gtools.r_fields true this))) basic.tvoid pos; - (* var i = 0; *) - mk (TVar (i_var, Some (make_int gen.gcon.basic 0 pos))) basic.tvoid pos; - (* while (i < fields.length) *) - mk (TWhile ( - binop OpLt local_i (mk_field_access gen local_fields "length" pos) basic.tbool pos, - mk (TBlock [ - (* var field = fields[i++]; *) - mk (TVar (field_var, Some (mk (TArray (local_fields, incr_i)) basic.tstring pos))) basic.tvoid pos; - ( - (* default: Reflect.setField(new_me, field, Reflect.field(this, field)) *) - let edef = gen.gtools.r_set_field basic.tvoid local_new_me local_field (gen.gtools.r_field false basic.tvoid this local_field) in - if fields <> [] then begin - (* switch(field) { ... } *) - let switch = mk_switch local_field (fields_to_cases fields) (Some edef) true in - mk (TSwitch switch) basic.tvoid pos - end else - edef; - ) - ]) basic.tvoid pos, - NormalWhile - )) basic.tvoid pos; - (* return new_me *) - mk_return local_new_me - ]) t_dynamic pos - } - in - cfield.cf_expr <- Some (mk (TFunction fn) cfield.cf_type pos); - cfield - - let create_static_cast_cf gen iface cf = - let p = iface.cl_pos in - let basic = gen.gcon.basic in - let cparams = List.map clone_param cf.cf_params in - let me_type = TInst(iface,[]) in - let cfield = mk_class_field ~static:true "__hx_cast" (TFun(["me",false,me_type], t_dynamic)) false iface.cl_pos (Method MethNormal) (cparams) in - let params = extract_param_types cparams in - - let me = alloc_var "me" me_type in - let field = { eexpr = TField(mk_local me p, FInstance(iface, extract_param_types iface.cl_params, cf)); etype = apply_params cf.cf_params params cf.cf_type; epos = p } in - let call = - { - eexpr = TCall(field, []); - etype = t_dynamic; - epos = p; - } in - let call = gen.gparam_func_call call field params [] in - - (* since object.someCall() isn't allowed on Haxe, we need to directly apply the params and delay this call *) - let delay () = - cfield.cf_expr <- - Some { - eexpr = TFunction( - { - tf_args = [me,None]; - tf_type = t_dynamic; - tf_expr = mk_return { - eexpr = TIf( - { eexpr = TBinop(Ast.OpNotEq, mk_local me p, null me.v_type p); etype = basic.tbool; epos = p }, - call, - Some( null me.v_type p ) - ); - etype = t_dynamic; - epos = p; - } - }); - etype = cfield.cf_type; - epos = p; - } - in - cfield, delay - - let default_implementation gen ifaces base_generic = - let add_iface cl = - gen.gadd_to_module (TClassDecl cl) (max_dep); - in - - let implement_stub_cast cthis iface tl = - let name = get_cast_name iface in - if not (PMap.mem name cthis.cl_fields) then begin - let cparams = List.map clone_param iface.cl_params in - let field = mk_class_field name (TFun([],t_dynamic)) false iface.cl_pos (Method MethNormal) cparams in - let this = { eexpr = TConst TThis; etype = TInst(cthis, extract_param_types cthis.cl_params); epos = cthis.cl_pos } in - field.cf_expr <- Some { - etype = TFun([],t_dynamic); - epos = this.epos; - eexpr = TFunction { - tf_type = t_dynamic; - tf_args = []; - tf_expr = mk_block (mk_return this) - } - }; - cthis.cl_ordered_fields <- field :: cthis.cl_ordered_fields; - cthis.cl_fields <- PMap.add name field cthis.cl_fields - end - in - - let run md = - match md with - | TClassDecl ({ cl_params = [] } as cl) -> - (* see if we're implementing any generic interface *) - let rec check (iface,tl) = - if tl <> [] && set_hxgeneric gen (TClassDecl iface) then - (* implement cast stub *) - implement_stub_cast cl iface tl; - List.iter (fun (s,stl) -> check (s, List.map (apply_params iface.cl_params tl) stl)) iface.cl_implements; - in - List.iter (check) cl.cl_implements; - md - | TClassDecl ({ cl_params = hd :: tl } as cl) when set_hxgeneric gen md -> - let iface = mk_class cl.cl_module cl.cl_path cl.cl_pos in - iface.cl_array_access <- Option.map (apply_params (cl.cl_params) (List.map (fun _ -> t_dynamic) cl.cl_params)) cl.cl_array_access; - if (has_class_flag cl CExtern) then add_class_flag iface CExtern; - iface.cl_module <- cl.cl_module; - iface.cl_private <- cl.cl_private; - iface.cl_meta <- - (Meta.HxGen, [], cl.cl_pos) - :: - (Meta.Custom "generic_iface", [(EConst(Int(string_of_int(List.length cl.cl_params), None)), cl.cl_pos)], cl.cl_pos) - :: - iface.cl_meta; - Hashtbl.add ifaces cl.cl_path iface; - - iface.cl_implements <- (base_generic, []) :: iface.cl_implements; - add_class_flag iface CInterface; - cl.cl_implements <- (iface, []) :: cl.cl_implements; - - let name = get_cast_name cl in - let cast_cf = create_cast_cfield gen cl name in - if not (has_class_flag cl CInterface) then create_stub_casts gen cl cast_cf; - - let rec loop c = match c.cl_super with - | None -> () - | Some(sup,_) -> try - let siface = Hashtbl.find ifaces sup.cl_path in - iface.cl_implements <- (siface,[]) :: iface.cl_implements; - () - with | Not_found -> loop sup - in - loop cl; - - (if not (has_class_flag cl CInterface) && not (has_class_flag cl CAbstract) then cl.cl_ordered_fields <- cast_cf :: cl.cl_ordered_fields); - let iface_cf = mk_class_field name cast_cf.cf_type false cast_cf.cf_pos (Method MethNormal) cast_cf.cf_params in - let cast_static_cf, delay = create_static_cast_cf gen iface iface_cf in - - cl.cl_ordered_statics <- cast_static_cf :: cl.cl_ordered_statics; - cl.cl_statics <- PMap.add cast_static_cf.cf_name cast_static_cf cl.cl_statics; - gen.gafter_filters_ended <- delay :: gen.gafter_filters_ended; (* do not let filters alter this expression content *) - - iface_cf.cf_type <- cast_cf.cf_type; - iface.cl_fields <- PMap.add name iface_cf iface.cl_fields; - let fields = List.filter (fun cf -> match cf.cf_kind with - | Var _ | Method MethDynamic -> false - | Method _ when has_class_field_flag cf CfAbstract -> false - | _ -> - let is_override = has_class_field_flag cf CfOverride in - let cf_type = if is_override && not (has_class_field_flag cf CfOverload) then - match find_first_declared_field gen cl cf.cf_name with - | Some(_,_,declared_t,_,_,_,_) -> declared_t - | _ -> Globals.die "" __LOC__ - else - cf.cf_type - in - - not (has_type_params cf_type) - ) cl.cl_ordered_fields - in - let fields = List.map (fun f -> mk_class_field f.cf_name f.cf_type (has_class_field_flag f CfPublic) f.cf_pos f.cf_kind f.cf_params) fields in - let fields = if has_class_flag cl CAbstract then fields else iface_cf :: fields in - iface.cl_ordered_fields <- fields; - List.iter (fun f -> iface.cl_fields <- PMap.add f.cf_name f iface.cl_fields) fields; - - add_iface iface; - md - | TTypeDecl _ | TAbstractDecl _ -> md - | TEnumDecl _ -> - ignore (set_hxgeneric gen md); - md - | _ -> ignore (set_hxgeneric gen md); md - in - run - - let configure gen mapping_func = - gen.gmodule_filters#add name (PCustom priority) mapping_func - -end;; - -(* create a common interface without type parameters and only a __Cast<> function *) -let default_implementation gen (dyn_tparam_cast:texpr->t->texpr) ifaces = - let change_expr e cl iface params = - let field = mk_static_field_access_infer cl "__hx_cast" e.epos params in - let elist = [mk_cast (TInst(iface,[])) e] in - let call = { eexpr = TCall(field, elist); etype = t_dynamic; epos = e.epos } in - - gen.gparam_func_call call field params elist - in - - let rec run e = - match e.eexpr with - | TCast(cast_expr, _) -> - (* see if casting to a native generic class *) - let t = gen.greal_type e.etype in - let unifies = - let ctype = gen.greal_type cast_expr.etype in - match follow ctype with - | TInst(cl,_) -> (try - unify ctype t; - true - with | Unify_error el -> - false) - | _ -> false - in - let unifies = unifies && not (Common.raw_defined gen.gcon "cs_safe_casts") in - (match follow t with - | TInst(cl, p1 :: pl) when is_hxgeneric (TClassDecl cl) && not unifies && not (Meta.has Meta.Enum cl.cl_meta) -> - let iface = Hashtbl.find ifaces cl.cl_path in - mk_cast e.etype (change_expr (Type.map_expr run cast_expr) cl iface (p1 :: pl)) - | _ -> Type.map_expr run e - ) - | _ -> Type.map_expr run e - in - run - -let configure gen (dyn_tparam_cast:texpr->t->texpr) ifaces base_generic = - gen.ghas_tparam_cast_handler <- true; - let traverse = default_implementation gen dyn_tparam_cast ifaces in - gen.gsyntax_filters#add name (PCustom priority) traverse; - RealTypeParamsModf.configure gen (RealTypeParamsModf.default_implementation gen ifaces base_generic) diff --git a/src/codegen/gencommon/reflectionCFs.ml b/src/codegen/gencommon/reflectionCFs.ml deleted file mode 100644 index e498b829a08..00000000000 --- a/src/codegen/gencommon/reflectionCFs.ml +++ /dev/null @@ -1,1542 +0,0 @@ -(* - The Haxe Compiler - Copyright (C) 2005-2019 Haxe Foundation - - This program is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License - as published by the Free Software Foundation; either version 2 - of the License, or (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. -*) -open Option -open Common -open Ast -open Type -open Texpr.Builder -open Gencommon -open ClosuresToClass - -(* ******************************************* *) -(* Reflection-enabling Class fields *) -(* ******************************************* *) -(* - This is the most hardcore codegen part of the code. There's much to improve so this code can be more readable, but at least it's running correctly right now! This will be improved. (TODO) - - This module will create class fields that enable reflection for targets that have a slow or inexistent reflection abilities. Because of the similarity - of strategies between what should have been different modules, they are all unified in this reflection-enabling class fields. - - They include: - * Get(throwErrors, isCheck) / Set fields . Remember to allow implements Dynamic also. - * Invoke fields() -> You need to configure how many invoke_field fields there will be. + invokeDynamic - * Has field -> parameter in get field that returns __undefined__ if it doesn't exist. - - * GetType -> return the current Class<> / Enum<> - * Fields() -> returns all the fields / static fields. Remember to allow implements Dynamic also - - * Create(arguments array), CreateEmpty - calls new() or create empty - * getInstanceFields / getClassFields -> show even function fields, everything! - - * deleteField -> only for implements Dynamic - - for enums: - * createEnum -> invokeField for classes - * createEnumIndex -> use invokeField as well, and use numbers e.g. "0", "1", "2" .... For this, use "@:alias" metadata - * getEnumConstructs -> fields() - - need to be solved outside: - * getEnumName - * enumIndex - * - - need to be solved by haxe code: - * enumParameters -> for (field in Reflect.fields(enum)) arr.push(Reflect.field(enum, field)) - - Standard: - if a class contains a @:$enum metadata, it's treated as a converted enum to class - - - Optimizations: - * if optimize is true, all fields will be hashed by the same hashing function as neko (31 bits int : always positive). Every function that expects a string for the field will expect also an int, for the hash - a string (which is nullable for compile-time hashes) + an int. - At compile-time, a collision will throw an error (like neko). - At runtime, a collision will make a negative int. Negative ints will always resolve to a special Hash<> field which takes a string. - * if optimize is true, Reflect.field/setField will be replaced by either the runtime version (with already hashed string), either by the own .Field()/.SetField() HxObject's version, - if the type is detected to already be hxgen - * TODO: if for() optimization for arrays is disabled, we can replace for(field in Reflect.fields(obj)) to: - for (field in ( (Std.is(obj, HxObject) ? ((HxObject)obj).Fields() : Reflect.fields(obj)) )) // no array copying . for further optimization this could be guaranteed to return - the already hashed fields. - - Mappings: - * if create Dynamic class is true, TObjectDecl will be mapped to new DynamicClass(fields, [hashedFields], values) - * - - dependencies: - There is no big dependency from this target. Though it should be a syntax filter, mainly one of the first so most expression generation has already been done, - while the AST has its meaning close to haxe's. - Should run before InitFunction so it detects variables containing expressions as "always-execute" expressions, even when using CreateEmpty - - * Must run before switch() syntax changes - -*) -let name = "reflection_cfs" - -type rcf_hash_conflict_ctx = { - t : t; - add_names : texpr->texpr->texpr; - get_conflict : texpr->texpr->texpr->texpr; - set : texpr->texpr->texpr->texpr->texpr; - delete : texpr->texpr->texpr->texpr; -} - -type rcf_ctx = -{ - rcf_gen : generator_ctx; - rcf_ft : ClosuresToClass.closures_ctx; - rcf_optimize : bool; - - rcf_object_iface : tclass; - rcf_dynamic_data_class : tclass option; - - rcf_max_func_arity : int; - - (* - the hash lookup function. can be an inlined expr or simply a function call. - its only needed features is that it should return the index of the key if found, and the - complement of the index of where it should be inserted if not found (Ints). - - hash->hash_array->length->returning expression - *) - rcf_hash_function : texpr->texpr->texpr->texpr; - - rcf_lookup_function : texpr->texpr; - - (* hash_array->length->pos->value *) - rcf_insert_function : texpr->texpr->texpr->texpr->texpr; - - (* hash_array->length->pos->value *) - rcf_remove_function : texpr->texpr->texpr->texpr; - - rcf_hash_fields : (int, string) Hashtbl.t; - - rcf_hash_paths : (Globals.path * int, string) Hashtbl.t; - - rcf_hash_conflict_ctx : rcf_hash_conflict_ctx option; - - rcf_mk_exception : string -> pos -> texpr; - - (* - main expr -> field expr -> field string -> possible hash int (if optimize) -> possible set expr -> should_throw_exceptions -> changed expression - - Changes a get / set field to the runtime resolution function - *) - rcf_on_getset_field : texpr->texpr->string->int32 option->texpr option->bool->texpr; - - rcf_on_call_field : texpr->texpr->string->int32 option->texpr list->texpr; -} - -let new_ctx gen ft object_iface ?dynamic_data_class optimize dynamic_getset_field dynamic_call_field hash_function lookup_function insert_function remove_function hash_conflict_ctx rcf_mk_exception = - { - rcf_gen = gen; - rcf_ft = ft; - - rcf_optimize = optimize; - rcf_dynamic_data_class = dynamic_data_class; - - rcf_object_iface = object_iface; - - rcf_max_func_arity = 10; - - rcf_hash_function = hash_function; - rcf_lookup_function = lookup_function; - - rcf_insert_function = insert_function; - rcf_remove_function = remove_function; - - rcf_hash_fields = Hashtbl.create 100; - rcf_hash_paths = Hashtbl.create 100; - - rcf_on_getset_field = dynamic_getset_field; - rcf_on_call_field = dynamic_call_field; - rcf_hash_conflict_ctx = hash_conflict_ctx; - rcf_mk_exception = rcf_mk_exception; - } - -(* - methods as a bool option is a little laziness of my part. - None means that methods are included with normal fields; - Some(true) means collect only methods - Some(false) means collect only fields (and MethDynamic fields) -*) -let collect_fields cl (methods : bool option) = - let collected = Hashtbl.create 0 in - let collect cf acc = - if Meta.has Meta.CompilerGenerated cf.cf_meta || Meta.has Meta.SkipReflection cf.cf_meta then - acc - else match methods, cf.cf_kind with - | None, _ when not (Hashtbl.mem collected cf.cf_name) -> Hashtbl.add collected cf.cf_name true; ([cf.cf_name], cf) :: acc - | Some true, Method MethDynamic -> acc - | Some true, Method _ when not (Hashtbl.mem collected cf.cf_name) -> Hashtbl.add collected cf.cf_name true; ([cf.cf_name], cf) :: acc - | Some false, Method MethDynamic - | Some false, Var _ when not (Hashtbl.mem collected cf.cf_name) -> Hashtbl.add collected cf.cf_name true; ([cf.cf_name], cf) :: acc - | _ -> acc - in - let collect_cfs cfs acc = - let rec loop cfs acc = - match cfs with - | [] -> acc - | hd :: tl -> loop tl (collect hd acc) - in - loop cfs acc - in - let rec loop cl acc = - let acc = collect_cfs cl.cl_ordered_fields acc in - match cl.cl_super with - | None -> acc - | Some(cl,_) -> - if not (is_hxgen (TClassDecl cl)) then loop cl acc else acc - in - - loop cl [] - -let hash_field ctx f pos = - let h = hash f in - (try - let f2 = Hashtbl.find ctx.rcf_hash_paths (ctx.rcf_gen.gcurrent_path, h) in - if f <> f2 then ctx.rcf_gen.gcon.error ("Field conflict between " ^ f ^ " and " ^ f2) pos - with Not_found -> - Hashtbl.add ctx.rcf_hash_paths (ctx.rcf_gen.gcurrent_path, h) f; - Hashtbl.replace ctx.rcf_hash_fields h f); - h - -(* ( tf_args, switch_var ) *) -let field_type_args ctx pos = - match ctx.rcf_optimize with - | true -> - let field_name, field_hash = alloc_var "field" ctx.rcf_gen.gcon.basic.tstring, alloc_var "hash" ctx.rcf_gen.gcon.basic.tint in - - [field_name, None; field_hash, None], field_hash - | false -> - let field_name = alloc_var "field" ctx.rcf_gen.gcon.basic.tstring in - [field_name, None], field_name - -let hash_field_i32 ctx pos field_name = - let i = hash_field ctx field_name pos in - let i = Int32.of_int (i) in - if i < Int32.zero then - Int32.logor (Int32.logand i (Int32.of_int 0x3FFFFFFF)) (Int32.shift_left Int32.one 30) - else i - -let switch_case ctx pos field_name = - match ctx.rcf_optimize with - | true -> - let i = hash_field_i32 ctx pos field_name in - mk (TConst (TInt i)) ctx.rcf_gen.gcon.basic.tint pos - | false -> - make_string ctx.rcf_gen.gcon.basic field_name pos - -let call_super ctx fn_args ret_t cf cl this_t pos = - { - eexpr = TCall({ - eexpr = TField({ eexpr = TConst(TSuper); etype = this_t; epos = pos }, FInstance(cl,extract_param_types cl.cl_params,cf)); - etype = TFun(fun_args fn_args, ret_t); - epos = pos; - }, List.map (fun (v,_) -> mk_local v pos) fn_args); - etype = ret_t; - epos = pos; - } - - -let enumerate_dynamic_fields ctx cl when_found base_arr = - let gen = ctx.rcf_gen in - let basic = gen.gcon.basic in - let pos = cl.cl_pos in - - let vtmp = alloc_var "i" basic.tint in - - let mk_for arr len = - let t = if ctx.rcf_optimize then basic.tint else basic.tstring in - let convert_str e = if ctx.rcf_optimize then ctx.rcf_lookup_function e else e in - let tmpinc = { eexpr = TUnop(Ast.Increment, Ast.Postfix, mk_local vtmp pos); etype = basic.tint; epos = pos } in - [ - { eexpr = TBinop(OpAssign, mk_local vtmp pos, make_int ctx.rcf_gen.gcon.basic 0 pos); etype = basic.tint; epos = pos }; - { - eexpr = TWhile ( - { eexpr = TBinop(Ast.OpLt, mk_local vtmp pos, len); etype = basic.tbool; epos = pos }, - mk_block (when_found (convert_str { eexpr = TArray (arr, tmpinc); etype = t; epos = pos })), - Ast.NormalWhile - ); - etype = basic.tvoid; - epos = pos - } - ] - in - - let this_t = TInst(cl, extract_param_types cl.cl_params) in - let this = { eexpr = TConst(TThis); etype = this_t; epos = pos } in - let mk_this field t = { (mk_field_access gen this field pos) with etype = t } in - - { eexpr = TVar (vtmp,None); etype = basic.tvoid; epos = pos } - :: - if ctx.rcf_optimize then - mk_for (mk_this (mk_internal_name "hx" "hashes") (gen.gclasses.nativearray basic.tint)) (mk_this (mk_internal_name "hx" "length") basic.tint) - @ - mk_for (mk_this (mk_internal_name "hx" "hashes_f") (gen.gclasses.nativearray basic.tint)) (mk_this (mk_internal_name "hx" "length_f") basic.tint) - @ - ( - let conflict_ctx = Option.get ctx.rcf_hash_conflict_ctx in - let ehead = mk_this (mk_internal_name "hx" "conflicts") conflict_ctx.t in - [conflict_ctx.add_names ehead base_arr] - ) - else - mk_for (mk_this (mk_internal_name "hx" "hashes") (gen.gclasses.nativearray basic.tstring)) (mk_this (mk_internal_name "hx" "length") basic.tint) - @ - mk_for (mk_this (mk_internal_name "hx" "hashes_f") (gen.gclasses.nativearray basic.tstring)) (mk_this (mk_internal_name "hx" "length_f") basic.tint) - -(* ********************* - Dynamic lookup - ********************* - - This is the behavior of standard classes. It will replace the error throwing - if a field doesn't exists when looking it up. - - In order for it to work, an implementation for hash_function must be created. - hash_function is the function to be called/inlined that will allow us to lookup the hash into a sorted array of hashes. - A binary search or linear search algorithm may be implemented. The only need is that if not found, the NegBits of - the place where it should be inserted must be returned. -*) -let abstract_dyn_lookup_implementation ctx this field_local hash_local may_value is_float pos = - let gen = ctx.rcf_gen in - let basic = gen.gcon.basic in - let mk_this field t = { (mk_field_access gen this field pos) with etype = t } in - let a_t = if ctx.rcf_optimize then basic.tint else basic.tstring in - let hx_hashes = mk_this (mk_internal_name "hx" "hashes") (gen.gclasses.nativearray a_t) in - let hx_hashes_f = mk_this (mk_internal_name "hx" "hashes_f") (gen.gclasses.nativearray a_t) in - let hx_dynamics = mk_this (mk_internal_name "hx" "dynamics") (gen.gclasses.nativearray t_empty) in - let hx_dynamics_f = mk_this (mk_internal_name "hx" "dynamics_f") (gen.gclasses.nativearray basic.tfloat) in - let hx_length = mk_this (mk_internal_name "hx" "length") (basic.tint) in - let hx_length_f = mk_this (mk_internal_name "hx" "length_f") (basic.tint) in - let res = alloc_var "res" basic.tint in - let fst_hash, snd_hash, fst_dynamics, snd_dynamics, fst_length, snd_length = - if is_float then - hx_hashes_f, hx_hashes, hx_dynamics_f, hx_dynamics, hx_length_f, hx_length - else - hx_hashes, hx_hashes_f, hx_dynamics, hx_dynamics_f, hx_length, hx_length_f - in - let res_local = mk_local res pos in - let gte = { - eexpr = TBinop(Ast.OpGte, res_local, { eexpr = TConst(TInt(Int32.zero)); etype = basic.tint; epos = pos }); - etype = basic.tbool; - epos = pos; - } in - let mk_tarray arr idx = - { - eexpr = TArray(arr, idx); - etype = gen.gclasses.nativearray_type arr.etype; - epos = pos; - } - in - let ret_t = if is_float then basic.tfloat else t_dynamic in - - match may_value with - | None -> - (* - var res = lookup(this.__hx_hashes/f, hash); - if (res < 0) - { - res = lookup(this.__hx_hashes_f/_, hash); - if(res < 0) - return null; - else - return __hx_dynamics_f[res]; - } else { - return __hx_dynamics[res]; - } - *) - let block = - [ - { eexpr = TVar(res, Some(ctx.rcf_hash_function hash_local fst_hash fst_length)); etype = basic.tvoid; epos = pos }; - { eexpr = TIf(gte, mk_return (mk_tarray fst_dynamics res_local), Some({ - eexpr = TBlock( - [ - { eexpr = TBinop(Ast.OpAssign, res_local, ctx.rcf_hash_function hash_local snd_hash snd_length); etype = basic.tint; epos = pos }; - { eexpr = TIf(gte, mk_return (mk_tarray snd_dynamics res_local), None); etype = ret_t; epos = pos } - ]); - etype = ret_t; - epos = pos; - })); etype = ret_t; epos = pos } - ] in - - if ctx.rcf_optimize then - let conflict_ctx = Option.get ctx.rcf_hash_conflict_ctx in - let ehead = mk_this (mk_internal_name "hx" "conflicts") conflict_ctx.t in - let vconflict = alloc_var "conflict" conflict_ctx.t in - let local_conflict = mk_local vconflict pos in - [mk (TIf ( - mk (TBinop (OpLt, hash_local, make_int gen.gcon.basic 0 pos)) basic.tbool pos, - mk (TBlock [ - mk (TVar (vconflict, Some (conflict_ctx.get_conflict ehead hash_local field_local))) basic.tvoid pos; - mk (TIf ( - mk (TBinop (OpNotEq, local_conflict, mk (TConst TNull) local_conflict.etype pos)) basic.tbool pos, - mk_return (field local_conflict "value" t_dynamic pos), - None - )) basic.tvoid pos; - ]) basic.tvoid pos, - Some (mk (TBlock block) basic.tvoid pos) - )) basic.tvoid pos] - else - block - | Some value_local -> - (* - //if is not float: - //if (isNumber(value_local)) return this.__hx_setField_f(field, getNumber(value_local), false(not static)); - var res = lookup(this.__hx_hashes/f, hash); - if (res >= 0) - { - return __hx_dynamics/f[res] = value_local; - } else { - res = lookup(this.__hx_hashes_f/_, hash); - if (res >= 0) - { - __hx_dynamics_f/_.splice(res,1); - __hx_hashes_f/_.splice(res,1); - } - } - - __hx_hashses/_f.insert(~res, hash); - __hx_dynamics/_f.insert(~res, value_local); - return value_local; - *) - let neg_res = { eexpr = TUnop(Ast.NegBits, Ast.Prefix, res_local); etype = basic.tint; epos = pos } in - - let res2 = alloc_var "res2" basic.tint in - let res2_local = mk_local res2 pos in - let gte2 = { - eexpr = TBinop(Ast.OpGte, res2_local, { eexpr = TConst(TInt(Int32.zero)); etype = basic.tint; epos = pos }); - etype = basic.tbool; - epos = pos; - } in - - let block = - [ - { eexpr = TVar(res, Some(ctx.rcf_hash_function hash_local fst_hash fst_length)); etype = basic.tvoid; epos = pos }; - { - eexpr = TIf(gte, - mk_return { eexpr = TBinop(Ast.OpAssign, mk_tarray fst_dynamics res_local, value_local); etype = value_local.etype; epos = pos }, - Some({ eexpr = TBlock([ - { eexpr = TVar( res2, Some(ctx.rcf_hash_function hash_local snd_hash snd_length)); etype = basic.tvoid; epos = pos }; - { - eexpr = TIf(gte2, { eexpr = TBlock([ - ctx.rcf_remove_function snd_hash snd_length res2_local; - ctx.rcf_remove_function snd_dynamics snd_length res2_local; - mk (TUnop(Decrement,Postfix,snd_length)) basic.tint pos - ]); etype = t_dynamic; epos = pos }, None); - etype = t_dynamic; - epos = pos; - } - ]); etype = t_dynamic; epos = pos })); - etype = t_dynamic; - epos = pos; - }; - ctx.rcf_insert_function fst_hash fst_length neg_res hash_local; - ctx.rcf_insert_function fst_dynamics fst_length neg_res value_local; - mk (TUnop(Increment,Postfix,fst_length)) basic.tint pos; - ] in - - let block = - if ctx.rcf_optimize then - let conflict_ctx = Option.get ctx.rcf_hash_conflict_ctx in - let ehead = mk_this (mk_internal_name "hx" "conflicts") conflict_ctx.t in - [mk (TIf ( - mk (TBinop (OpLt, hash_local, make_int gen.gcon.basic 0 pos)) basic.tbool pos, - conflict_ctx.set ehead hash_local field_local value_local, - Some (mk (TBlock block) basic.tvoid pos) - )) basic.tvoid pos] - else - block - in - block @ [mk_return value_local] - -let get_delete_field ctx cl is_dynamic = - let pos = cl.cl_pos in - let this_t = TInst(cl, extract_param_types cl.cl_params) in - let this = { eexpr = TConst(TThis); etype = this_t; epos = pos } in - let gen = ctx.rcf_gen in - let basic = gen.gcon.basic in - let tf_args, switch_var = field_type_args ctx pos in - let local_switch_var = mk_local switch_var pos in - let fun_type = TFun(fun_args tf_args,basic.tbool) in - let cf = mk_class_field (mk_internal_name "hx" "deleteField") fun_type false pos (Method MethNormal) [] in - let body = if is_dynamic then begin - let mk_this field t = { (mk_field_access gen this field pos) with etype = t } in - let a_t = if ctx.rcf_optimize then basic.tint else basic.tstring in - let hx_hashes = mk_this (mk_internal_name "hx" "hashes") (gen.gclasses.nativearray a_t) in - let hx_hashes_f = mk_this (mk_internal_name "hx" "hashes_f") (gen.gclasses.nativearray a_t) in - let hx_dynamics = mk_this (mk_internal_name "hx" "dynamics") (gen.gclasses.nativearray t_empty) in - let hx_dynamics_f = mk_this (mk_internal_name "hx" "dynamics_f") (gen.gclasses.nativearray basic.tfloat) in - let hx_length = mk_this (mk_internal_name "hx" "length") (basic.tint) in - let hx_length_f = mk_this (mk_internal_name "hx" "length_f") (basic.tint) in - let res = alloc_var "res" basic.tint in - let res_local = mk_local res pos in - let gte = { - eexpr = TBinop(Ast.OpGte, res_local, { eexpr = TConst(TInt(Int32.zero)); etype = basic.tint; epos = pos }); - etype = basic.tbool; - epos = pos; - } in - (* - var res = lookup(this.__hx_hashes, hash); - if (res >= 0) - { - __hx_dynamics.splice(res,1); - __hx_hashes.splice(res,1); - - return true; - } else { - res = lookup(this.__hx_hashes_f, hash); - if (res >= 0) - { - __hx_dynamics_f.splice(res,1); - __hx_hashes_f.splice(res,1); - - return true; - } - } - - return false; - *) - let common = [ - { eexpr = TVar(res,Some(ctx.rcf_hash_function local_switch_var hx_hashes hx_length)); etype = basic.tvoid; epos = pos }; - { - eexpr = TIf(gte, { eexpr = TBlock([ - ctx.rcf_remove_function hx_hashes hx_length res_local; - ctx.rcf_remove_function hx_dynamics hx_length res_local; - mk (TUnop(Decrement,Postfix,hx_length)) basic.tint pos; - mk_return { eexpr = TConst(TBool true); etype = basic.tbool; epos = pos } - ]); etype = t_dynamic; epos = pos }, Some({ eexpr = TBlock([ - { eexpr = TBinop(Ast.OpAssign, res_local, ctx.rcf_hash_function local_switch_var hx_hashes_f hx_length_f); etype = basic.tint; epos = pos }; - { eexpr = TIf(gte, { eexpr = TBlock([ - ctx.rcf_remove_function hx_hashes_f hx_length_f res_local; - ctx.rcf_remove_function hx_dynamics_f hx_length_f res_local; - mk (TUnop(Decrement,Postfix,hx_length_f)) basic.tint pos; - mk_return { eexpr = TConst(TBool true); etype = basic.tbool; epos = pos } - ]); etype = t_dynamic; epos = pos }, None); etype = t_dynamic; epos = pos } - ]); etype = t_dynamic; epos = pos })); - etype = t_dynamic; - epos = pos; - }; - mk_return { eexpr = TConst(TBool false); etype = basic.tbool; epos = pos } - ] in - - if ctx.rcf_optimize then - let v_name = match tf_args with (v,_) :: _ -> v | _ -> Globals.die "" __LOC__ in - let local_name = mk_local v_name pos in - let conflict_ctx = Option.get ctx.rcf_hash_conflict_ctx in - let ehead = mk_this (mk_internal_name "hx" "conflicts") conflict_ctx.t in - (mk (TIf ( - binop OpLt local_switch_var (make_int gen.gcon.basic 0 pos) basic.tbool pos, - mk_return (conflict_ctx.delete ehead local_switch_var local_name), - None - )) basic.tvoid pos) :: common - else - common - end else - [ - mk_return { eexpr = TConst(TBool false); etype = basic.tbool; epos = pos } - ] in - - (* create function *) - let fn = - { - tf_args = tf_args; - tf_type = basic.tbool; - tf_expr = { eexpr = TBlock(body); etype = t_dynamic; epos = pos } - } in - cf.cf_expr <- Some({ eexpr = TFunction(fn); etype = fun_type; epos = pos }); - cf - -let is_override cl = match cl.cl_super with - | Some (cl, _) when is_hxgen (TClassDecl cl) -> true - | _ -> false - -(* WARNING: this will only work if overloading contructors is possible on target language *) -let implement_dynamic_object_ctor ctx cl = - let rec is_side_effects_free e = - match e.eexpr with - | TConst _ - | TLocal _ - | TFunction _ - | TTypeExpr _ -> - true - | TNew(clnew,[],params) when clnew == cl -> - List.for_all is_side_effects_free params - | TUnop(Increment,_,_) - | TUnop(Decrement,_,_) - | TBinop(OpAssign,_,_) - | TBinop(OpAssignOp _,_,_) -> - false - | TUnop(_,_,e) -> - is_side_effects_free e - | TArray(e1,e2) - | TBinop(_,e1,e2) -> - is_side_effects_free e1 && is_side_effects_free e2 - | TIf(cond,e1,Some e2) -> - is_side_effects_free cond && is_side_effects_free e1 && is_side_effects_free e2 - | TField(e,_) - | TParenthesis e | TMeta(_,e) -> is_side_effects_free e - | TArrayDecl el -> List.for_all is_side_effects_free el - | TCast(e,_) -> is_side_effects_free e - | _ -> false - in - - let pos = cl.cl_pos in - let gen = ctx.rcf_gen in - let basic = gen.gcon.basic in - let hasht = if ctx.rcf_optimize then basic.tint else basic.tstring in - - (* and finally we will return a function that transforms a TObjectDecl into a new DynamicObject() call *) - let rec loop objdecl acc acc_f = - match objdecl with - | [] -> acc,acc_f - | (name,expr) :: tl -> - let real_t = gen.greal_type expr.etype in - match follow expr.etype with - | TInst ( { cl_path = ["haxe"], "Int64" }, [] ) -> - loop tl ((name, gen.ghandle_cast t_dynamic real_t expr) :: acc) acc_f - | _ -> - if like_float real_t && not (like_i64 real_t) then - loop tl acc ((name, gen.ghandle_cast basic.tfloat real_t expr) :: acc_f) - else - loop tl ((name, gen.ghandle_cast t_dynamic real_t expr) :: acc) acc_f - in - - let may_hash_field s = - if ctx.rcf_optimize then begin - mk (TConst (TInt (hash_field_i32 ctx pos s))) basic.tint pos - end else begin - make_string gen.gcon.basic s pos - end - in - - let do_objdecl e objdecl = - let exprs_before = ref [] in - let rec change_exprs decl acc = match decl with - | ((name,_,_),expr) :: tl -> - if is_side_effects_free expr then - change_exprs tl ((name,expr) :: acc) - else begin - let var = mk_temp "odecl" expr.etype in - exprs_before := { eexpr = TVar(var,Some expr); etype = basic.tvoid; epos = expr.epos } :: !exprs_before; - change_exprs tl ((name,mk_local var expr.epos) :: acc) - end - | [] -> acc - in - let objdecl = change_exprs objdecl [] in - - let odecl, odecl_f = loop objdecl [] [] in - let changed_expr = List.map (fun (s,e) -> (may_hash_field s,e)) in - let odecl, odecl_f = changed_expr odecl, changed_expr odecl_f in - let sort_fn (e1,_) (e2,_) = - match e1.eexpr, e2.eexpr with - | TConst(TInt i1), TConst(TInt i2) -> compare i1 i2 - | TConst(TString s1), TConst(TString s2) -> compare s1 s2 - | _ -> Globals.die "" __LOC__ - in - - let odecl, odecl_f = List.sort sort_fn odecl, List.sort sort_fn odecl_f in - let ret = { - e with eexpr = TNew(cl,[], - [ - mk_nativearray_decl gen hasht (List.map fst odecl) pos; - mk_nativearray_decl gen t_empty (List.map snd odecl) pos; - mk_nativearray_decl gen hasht (List.map fst odecl_f) pos; - mk_nativearray_decl gen basic.tfloat (List.map snd odecl_f) pos; - ]); - } in - match !exprs_before with - | [] -> ret - | block -> - { - eexpr = TBlock(List.rev block @ [ret]); - etype = ret.etype; - epos = ret.epos; - } - in - do_objdecl - -(* - Implements: - __hx_lookupField(field:String, throwErrors:Bool, isCheck:Bool, handleProperties:Bool, isFirst:Bool):Dynamic - - __hx_lookupField_f(field:String, throwErrors:Bool, handleProperties:Bool, isFirst:Bool):Float - - __hx_lookupSetField(field:String, value:Dynamic, handleProperties:Bool, isFirst:Bool):Dynamic; - - __hx_lookupSetField(field:String, value:Float, handleProperties:Bool, isFirst:Bool):Float; -*) -let implement_final_lookup ctx cl = - let gen = ctx.rcf_gen in - let basic = gen.gcon.basic in - let pos = cl.cl_pos in - let is_override = is_override cl in - - (* let this = { eexpr = TConst(TThis); etype = TInst(cl, extract_param_types cl.cl_params); epos = pos } in *) - - let mk_throw str pos = - let e = ctx.rcf_mk_exception str pos in - make_throw e pos - in - - (* - this function will create the class fields and call callback for each version - - callback : is_float fields_args switch_var throw_errors_option is_check_option value_option : texpr list - *) - let create_cfs is_dynamic callback = - let create_cf is_float is_set = - let name = mk_internal_name "hx" ( (if is_set then "lookupSetField" else "lookupField") ^ (if is_float then "_f" else "") ) in - let field_args, switch_var = field_type_args ctx pos in - let ret_t = if is_float then basic.tfloat else t_dynamic in - let tf_args, throw_errors_opt = - if is_set then - field_args, None - else - let v = alloc_var "throwErrors" basic.tbool in - field_args @ [v,None], Some v - in - let tf_args, is_check_opt = - if is_set || is_float then - tf_args, None - else - let v = alloc_var "isCheck" basic.tbool in - tf_args @ [v,None], Some v - in - let tf_args, value_opt = - if not is_set then - tf_args, None - else - let v = alloc_var "value" ret_t in - field_args @ [v,None], Some v - in - - let fun_t = TFun(fun_args tf_args, ret_t) in - let cf = mk_class_field name fun_t false pos (Method MethNormal) [] in - let block = callback is_float field_args switch_var throw_errors_opt is_check_opt value_opt in - let block = if not is_set then let tl = begin - let throw_errors_local = mk_local (get throw_errors_opt) pos in - let mk_check_throw msg = - { - eexpr = TIf(throw_errors_local, mk_throw msg pos, Some (mk_return (null ret_t pos))); - etype = ret_t; - epos = pos - } in - - let mk_may_check_throw msg = if is_dynamic then mk_return (null ret_t pos) else mk_check_throw msg in - if is_float then begin - [ - mk_may_check_throw "Field not found or incompatible field type."; - ] - end else begin - let is_check_local = mk_local (get is_check_opt) pos in - [ - { - eexpr = TIf(is_check_local, mk_return (undefined pos), Some( mk_may_check_throw "Field not found." )); - etype = ret_t; - epos = pos; - } - ] - end - end in block @ tl else block in - cf.cf_expr <- Some( - { - eexpr = TFunction({ - tf_args = tf_args; - tf_type = ret_t; - tf_expr = { eexpr = TBlock(block); etype = ret_t; epos = pos } - }); - etype = fun_t; - epos = pos - } - ); - cf - in - let cfs = - [ - create_cf false false; - create_cf true false; - create_cf false true; - create_cf true true - ] in - cl.cl_ordered_fields <- cl.cl_ordered_fields @ cfs; - List.iter (fun cf -> - cl.cl_fields <- PMap.add cf.cf_name cf cl.cl_fields; - if is_override then add_class_field_flag cf CfOverride - ) cfs - in - if not is_override then begin - create_cfs false (fun is_float fields_args switch_var _ _ value_opt -> - match value_opt with - | None -> (* is not set *) - [] - | Some _ -> (* is set *) - if is_float then - [ mk_throw "Cannot access field for writing or incompatible type." pos ] - else - [ mk_throw "Cannot access field for writing." pos ] - ) - end - -(* *) -let implement_get_set ctx cl = - let gen = ctx.rcf_gen in - let mk_cfield is_set is_float = - let pos = cl.cl_pos in - let basic = ctx.rcf_gen.gcon.basic in - let tf_args, switch_var = field_type_args ctx pos in - let field_args = tf_args in - let local_switch_var = { eexpr = TLocal(switch_var); etype = switch_var.v_type; epos = pos } in - - let handle_prop = alloc_var "handleProperties" basic.tbool in - let handle_prop_local = mk_local handle_prop pos in - - let this = { eexpr = TConst TThis; etype = TInst(cl, extract_param_types cl.cl_params); epos = pos } in - let mk_this_call_raw name fun_t params = - { eexpr = TCall( { (mk_field_access gen this name pos) with etype = fun_t; }, params ); etype = snd (get_fun fun_t); epos = pos } - in - - let fun_type = ref (TFun([], basic.tvoid)) in - let fun_name = mk_internal_name "hx" ( (if is_set then "setField" else "getField") ^ (if is_float then "_f" else "") ) in - let cfield = mk_class_field fun_name !fun_type false pos (Method MethNormal) [] in - - let maybe_cast e = e in - - let t = TInst(cl, extract_param_types cl.cl_params) in - - (* if it's not latest hxgen class -> check super *) - let mk_do_default args do_default = - match cl.cl_super with - | None -> fun () -> maybe_cast (do_default ()) - | Some (super, sparams) when not (is_hxgen (TClassDecl super)) -> - fun () -> maybe_cast (do_default ()) - | _ -> - fun () -> - mk_return { - eexpr = TCall( - { eexpr = TField({ eexpr = TConst TSuper; etype = t; epos = pos }, FInstance(cl, extract_param_types cl.cl_params, cfield)); etype = !fun_type; epos = pos }, - (List.map (fun (v,_) -> mk_local v pos) args) ); - etype = if is_float then basic.tfloat else t_dynamic; - epos = pos; - }; - in - - (* if it is set function, there are some different set fields to do *) - let do_default, do_field, tf_args = if is_set then begin - let value_var = alloc_var "value" (if is_float then basic.tfloat else t_dynamic) in - let value_local = { eexpr = TLocal(value_var); etype = value_var.v_type; epos = pos } in - let tf_args = tf_args @ [value_var,None; handle_prop, None; ] in - let lookup_name = mk_internal_name "hx" ("lookupSetField" ^ if is_float then "_f" else "") in - - let do_default = - fun () -> - mk_return (mk_this_call_raw lookup_name (TFun(fun_args (field_args @ [value_var,None]),value_var.v_type)) ( List.map (fun (v,_) -> mk_local v pos) field_args @ [ value_local ] )) - in - - let do_field cf cf_type = - let get_field ethis = { eexpr = TField (ethis, FInstance(cl, extract_param_types cl.cl_params, cf)); etype = cf_type; epos = pos } in - let this = { eexpr = TConst(TThis); etype = t; epos = pos } in - let value_local = if is_float then match follow cf_type with - | TInst({ cl_kind = KTypeParameter _ }, _) -> - mk_cast t_dynamic value_local - | _ -> - value_local - else - value_local - in - - let ret = - { - eexpr = TBlock([ - { - eexpr = TBinop(Ast.OpAssign, - get_field this, - mk_cast cf_type value_local); - etype = cf_type; - epos = pos; - }; - mk_return value_local - ]); - etype = cf_type; - epos = pos; - } in - match cf.cf_kind with - | Var { v_write = AccCall } -> - let bl = - [ - mk_this_call_raw ("set_" ^ cf.cf_name) (TFun(["value",false,cf.cf_type], cf.cf_type)) [ value_local ]; - mk_return value_local - ] in - if not (Type.is_physical_field cf) then - { eexpr = TBlock bl; etype = value_local.etype; epos = pos } - else - { - eexpr = TIf( - handle_prop_local, - { eexpr = TBlock bl; etype = value_local.etype; epos = pos }, - Some ret); - etype = value_local.etype; - epos = pos; - } - | _ -> - ret - in - - (mk_do_default tf_args do_default, do_field, tf_args) - end else begin - let throw_errors = alloc_var "throwErrors" basic.tbool in - let throw_errors_local = mk_local throw_errors pos in - let do_default, tf_args = if not is_float then begin - let is_check = alloc_var "isCheck" basic.tbool in - let is_check_local = mk_local is_check pos in - - let tf_args = tf_args @ [ throw_errors,None; ] in - - (* default: if (isCheck) return __undefined__ else if(throwErrors) throw "Field not found"; else return null; *) - let lookup_name = mk_internal_name "hx" "lookupField" in - let do_default = - fun () -> - mk_return (mk_this_call_raw lookup_name (TFun(fun_args (field_args @ [throw_errors,None;is_check,None; ]),t_dynamic)) ( List.map (fun (v,_) -> mk_local v pos) field_args @ [ throw_errors_local; is_check_local; ] )) - in - - (do_default, tf_args @ [ is_check,None; handle_prop,None; ]) - end else begin - let tf_args = tf_args @ [ throw_errors,None; ] in - - let lookup_name = mk_internal_name "hx" "lookupField_f" in - let do_default = - fun () -> - mk_return (mk_this_call_raw lookup_name (TFun(fun_args (field_args @ [throw_errors,None; ]),basic.tfloat)) ( List.map (fun (v,_) -> mk_local v pos) field_args @ [ throw_errors_local; ] )) - in - - (do_default, tf_args @ [ handle_prop,None; ]) - end in - - let get_field cf cf_type ethis cl name = - match cf.cf_kind with - | Var { v_read = AccCall } when not (Type.is_physical_field cf) -> - mk_this_call_raw ("get_" ^ cf.cf_name) (TFun(["value",false,cf.cf_type], cf.cf_type)) [] - | Var { v_read = AccCall } -> - { - eexpr = TIf( - handle_prop_local, - mk_this_call_raw ("get_" ^ cf.cf_name) (TFun(["value",false,cf.cf_type], cf.cf_type)) [], - Some { eexpr = TField (ethis, FInstance(cl, extract_param_types cl.cl_params, cf)); etype = cf_type; epos = pos } - ); - etype = cf_type; - epos = pos; - } - | Var _ - | Method MethDynamic -> { eexpr = TField (ethis, FInstance(cl,extract_param_types cl.cl_params,cf)); etype = cf_type; epos = pos } - | _ -> - { eexpr = TField (this, FClosure(Some (cl,extract_param_types cl.cl_params), cf)); etype = cf_type; epos = pos } - in - - let do_field cf cf_type = - let this = { eexpr = TConst(TThis); etype = t; epos = pos } in - match is_float, follow cf_type with - | true, TInst( { cl_kind = KTypeParameter _ }, _ ) -> - mk_return (mk_cast basic.tfloat (mk_cast t_dynamic (get_field cf cf_type this cl cf.cf_name))) - | _ -> - mk_return (maybe_cast (get_field cf cf_type this cl cf.cf_name )) - in - (mk_do_default tf_args do_default, do_field, tf_args) - end in - - let get_fields() = - let ret = collect_fields cl ( if is_float || is_set then Some (false) else None ) in - let ret = if is_set then List.filter (fun (_,cf) -> - match cf.cf_kind with - (* | Var { v_write = AccNever } -> false *) - | _ -> not (Meta.has Meta.ReadOnly cf.cf_meta)) ret - else - List.filter (fun (_,cf) -> - match cf.cf_kind with - (* | Var { v_read = AccNever } -> false *) - | _ -> true) ret in - if is_float then - List.filter (fun (_,cf) -> (* TODO: maybe really apply_params in cf.cf_type. The benefits would be limited, though *) - match follow (ctx.rcf_gen.greal_type (ctx.rcf_gen.gfollow#run_f cf.cf_type)) with - | TDynamic _ | TMono _ - | TInst ({ cl_kind = KTypeParameter _ }, _) -> true - | t when like_float t && not (like_i64 t) -> true - | _ -> false - ) ret - else - (* dynamic will always contain all references *) - ret - in - - (* now we have do_default, do_field and tf_args *) - (* so create the switch expr *) - fun_type := TFun(List.map (fun (v,_) -> (v.v_name, false, v.v_type)) tf_args, if is_float then basic.tfloat else t_dynamic ); - let has_fields = ref false in - - let content = - let fields = get_fields() in - let fields = List.filter - (fun (_, cf) -> match is_set, cf.cf_kind with - | true, Var { v_write = AccCall } -> true - | false, Var { v_read = AccCall } -> true - | _ -> Type.is_physical_field cf && not (has_meta Meta.ReadOnly cf.cf_meta) - ) - fields - in - (if fields <> [] then has_fields := true); - let cases = List.map (fun (names, cf) -> - (if names = [] then Globals.die "" __LOC__); - { - case_patterns = List.map (switch_case ctx pos) names; - case_expr = do_field cf cf.cf_type; - } - ) fields in - let default = Some(do_default()) in - let switch = mk_switch local_switch_var cases default true in - mk_block { eexpr = TSwitch switch; etype = basic.tvoid; epos = pos } - in - - let is_override = match cl.cl_super with - | Some (cl, _) when is_hxgen (TClassDecl cl) -> true - | _ -> false - in - - if !has_fields || (not is_override) then begin - let func = - { - tf_args = tf_args; - tf_type = if is_float then basic.tfloat else t_dynamic; - tf_expr = content; - } in - - let func = { eexpr = TFunction(func); etype = !fun_type; epos = pos } in - - cfield.cf_type <- !fun_type; - cfield.cf_expr <- Some func; - - cl.cl_ordered_fields <- cl.cl_ordered_fields @ [cfield]; - cl.cl_fields <- PMap.add fun_name cfield cl.cl_fields; - - (if is_override then add_class_field_flag cfield CfOverride) - end else () - in - mk_cfield true true; - mk_cfield true false; - mk_cfield false false; - mk_cfield false true - -let implement_getFields ctx cl = - let gen = ctx.rcf_gen in - let basic = gen.gcon.basic in - let pos = cl.cl_pos in - - (* - function __hx_getFields(baseArr:Array) - { - //add all variable fields - //then: - super.__hx_getFields(baseArr); - } - *) - let name = mk_internal_name "hx" "getFields" in - let v_base_arr = alloc_var "baseArr" (basic.tarray basic.tstring) in - let base_arr = mk_local v_base_arr pos in - - let tf_args = [(v_base_arr,None)] in - let t = TFun(fun_args tf_args, basic.tvoid) in - let cf = mk_class_field name t false pos (Method MethNormal) [] in - - let e_pushfield = mk_field_access gen base_arr "push" pos in - let mk_push value = mk (TCall (e_pushfield, [value])) basic.tint pos in - - let has_value = ref false in - let map_fields = - List.map (fun (_,cf) -> - match cf.cf_kind with - | Var _ - | Method MethDynamic when not (has_class_field_flag cf CfOverride) -> - has_value := true; - mk_push (make_string gen.gcon.basic cf.cf_name pos) - | _ -> null basic.tvoid pos - ) - in - - (* - if it is first_dynamic, then we need to enumerate the dynamic fields - *) - let exprs = - if is_override cl then - let tparams = extract_param_types cl.cl_params in - let esuper = mk (TConst TSuper) (TInst(cl, tparams)) pos in - let efield = mk (TField (esuper, FInstance (cl, tparams, cf))) t pos in - [mk (TCall (efield, [base_arr])) basic.tvoid pos] - else - [] - in - - let exprs = map_fields (collect_fields cl (Some false)) @ exprs in - - cf.cf_expr <- Some { - eexpr = TFunction({ - tf_args = tf_args; - tf_type = basic.tvoid; - tf_expr = mk (TBlock exprs) basic.tvoid pos - }); - etype = t; - epos = pos - }; - - if !has_value || not (is_override cl) then begin - cl.cl_ordered_fields <- cl.cl_ordered_fields @ [cf]; - cl.cl_fields <- PMap.add cf.cf_name cf cl.cl_fields; - (if is_override cl then add_class_field_flag cf CfOverride) - end - - -let implement_invokeField ctx slow_invoke cl = - (* - There are two ways to implement an haxe reflection-enabled class: - When we extend a non-hxgen class, and when we extend the base HxObject class. - - Because of the added boiler plate we'd add every time we extend a non-hxgen class to implement a big IHxObject - interface, we'll handle the cases differently when implementing each interface. - - At the IHxObject interface, there's only invokeDynamic(field, args[]), while at the HxObject class there are - the other, more optimized methods, that follow the Function class interface. - - Since this will only be called by the Closure class, this conversion can be properly dealt with later. - - TODO: create the faster version. By now only invokeDynamic will be implemented - *) - let gen = ctx.rcf_gen in - let basic = gen.gcon.basic in - let pos = cl.cl_pos in - - let has_method = ref false in - - let is_override = ref false in - let rec extends_hxobject cl = - match cl.cl_super with - | None -> true - | Some (cl,_) when is_hxgen (TClassDecl cl) -> is_override := true; extends_hxobject cl - | _ -> false - in - - let field_args, switch_var = field_type_args ctx cl.cl_pos in - let field_args_exprs = List.map (fun (v,_) -> mk_local v pos) field_args in - - let dynamic_arg = alloc_var "dynargs" (gen.gclasses.nativearray t_dynamic) in - let all_args = field_args @ [ dynamic_arg, None ] in - let fun_t = TFun(fun_args all_args, t_dynamic) in - - let this_t = TInst(cl, extract_param_types cl.cl_params) in - let this = { eexpr = TConst(TThis); etype = this_t; epos = pos } in - - let mk_this_call_raw name fun_t params = - { eexpr = TCall( { (mk_field_access gen this name pos) with etype = fun_t }, params ); etype = snd (get_fun fun_t); epos = pos } - in - - let extends_hxobject = extends_hxobject cl in - ignore extends_hxobject; - - (* creates a invokeField of the class fields listed here *) - (* - function invokeField(field, dynargs) - { - switch(field) - { - case "a": this.a(dynargs[0], dynargs[1], dynargs[2]...); - default: super.invokeField //or this.getField(field).invokeDynamic(dynargs) - } - } - *) - - let dyn_fun = mk_class_field (mk_internal_name "hx" "invokeField") fun_t false cl.cl_pos (Method MethNormal) [] in - - let mk_switch_dyn cfs old = - let get_case (names,cf) = - has_method := true; - let i = ref 0 in - let dyn_arg_local = mk_local dynamic_arg pos in - let length_name = match ctx.rcf_gen.gcon.platform with Cs -> "Length" | _ -> "length" in - let dyn_arg_length = field dyn_arg_local length_name ctx.rcf_gen.gcon.basic.tint pos in - let cases = List.map (switch_case ctx pos) names in - - let mk_this_call cf params = - let t = apply_params cf.cf_params (List.map (fun _ -> t_dynamic) cf.cf_params) cf.cf_type in - mk_this_call_raw cf.cf_name t params - in - { - case_patterns = cases; - case_expr = mk_return ( - mk_this_call cf (List.map (fun (name,optional,t) -> - let idx = make_int ctx.rcf_gen.gcon.basic !i pos in - let ret = { eexpr = TArray(dyn_arg_local, idx); etype = t_dynamic; epos = pos } in - let ret = - if ExtType.is_rest t then - { ret with eexpr = TUnop(Spread,Prefix,{ ret with etype = t }) } - else - ret - in - incr i; - if optional then - let condition = binop OpGt dyn_arg_length idx ctx.rcf_gen.gcon.basic.tbool pos in - mk (TIf (condition, ret, Some (make_null ret.etype pos))) ret.etype pos - else - ret - ) (fst (get_fun (cf.cf_type)))) - ) - } - in - - let cfs = List.filter (fun (_,cf) -> match cf.cf_kind with - | Method _ -> if has_class_field_flag cf CfOverride then false else true - | _ -> true) cfs - in - - let cases = List.map get_case cfs in - let cases = match old with - | [] -> cases - | _ -> - let ncases = List.map (fun cf -> switch_case ctx pos cf.cf_name) old in - { - case_patterns = ncases; - case_expr = mk_return (slow_invoke this (mk_local (fst (List.hd field_args)) pos) (mk_local dynamic_arg pos)) - } :: cases - in - - let default = if !is_override then - mk_return (call_super ctx all_args t_dynamic dyn_fun cl this_t pos) - else ( - let field = begin - let fun_name = mk_internal_name "hx" "getField" in - let tf_args, _ = field_type_args ctx pos in - let tf_args, args = fun_args tf_args, field_args_exprs in - - let tf_args, args = tf_args @ ["throwErrors",false, basic.tbool], args @ [make_bool gen.gcon.basic true pos] in - let tf_args, args = tf_args @ ["isCheck", false, basic.tbool], args @ [make_bool gen.gcon.basic false pos] in - let tf_args, args = tf_args @ ["handleProperties", false, basic.tbool], args @ [make_bool gen.gcon.basic false pos] in - - mk (TCall ({ (mk_field_access gen this fun_name pos) with etype = TFun(tf_args, t_dynamic) }, args)) t_dynamic pos - end in - let field = mk_cast (TInst(ctx.rcf_ft.func_class,[])) field in - mk_return { - eexpr = TCall( - mk_field_access gen field (mk_internal_name "hx" "invokeDynamic") pos, - [mk_local dynamic_arg pos]); - etype = t_dynamic; - epos = pos - } ) - in - let switch = mk_switch (mk_local switch_var pos) cases (Some default) true in - { - eexpr = TSwitch switch; - etype = basic.tvoid; - epos = pos; - } - in - - let contents = - let nonstatics = collect_fields cl (Some true) in - - let old_nonstatics = ref [] in - - let nonstatics = - List.filter (fun (n,cf) -> - let is_old = not (PMap.mem cf.cf_name cl.cl_fields) || has_class_field_flag cf CfOverride in - (if is_old then old_nonstatics := cf :: !old_nonstatics); - not is_old - ) nonstatics - in - - mk_switch_dyn nonstatics !old_nonstatics - in - - dyn_fun.cf_expr <- Some - { - eexpr = TFunction( - { - tf_args = all_args; - tf_type = t_dynamic; - tf_expr = mk_block contents; - }); - etype = TFun(fun_args all_args, t_dynamic); - epos = pos; - }; - if !is_override && not (!has_method) then () else begin - cl.cl_ordered_fields <- cl.cl_ordered_fields @ [dyn_fun]; - cl.cl_fields <- PMap.add dyn_fun.cf_name dyn_fun cl.cl_fields; - (if !is_override then add_class_field_flag dyn_fun CfOverride) - end - -let implement_varargs_cl ctx cl = - let pos = cl.cl_pos in - let gen = ctx.rcf_gen in - - let this_t = TInst(cl, extract_param_types cl.cl_params) in - let this = { eexpr = TConst(TThis); etype = this_t ; epos = pos } in - let mk_this field t = { (mk_field_access gen this field pos) with etype = t } in - - let invokedyn = mk_internal_name "hx" "invokeDynamic" in - let idyn_t = TFun([mk_internal_name "fn" "dynargs", false, gen.gclasses.nativearray t_dynamic], t_dynamic) in - let this_idyn = mk_this invokedyn idyn_t in - - let map_fn arity ret vars api = - - let rec loop i acc = - if i < 0 then - acc - else - let obj = api i t_dynamic None in - loop (i - 1) (obj :: acc) - in - - let call_arg = if arity = (-1) then - api (-1) t_dynamic None - else if arity = 0 then - null (gen.gclasses.nativearray t_empty) pos - else - mk_nativearray_decl gen t_empty (loop (arity - 1) []) pos - in - - let expr = { - eexpr = TCall( - this_idyn, - [ call_arg ] - ); - etype = t_dynamic; - epos = pos - } in - - let expr = if like_float ret && not (like_int ret) then mk_cast ret expr else expr in - - mk_return expr - in - - let all_cfs = List.filter (fun cf -> cf.cf_name <> "new" && cf.cf_name <> (invokedyn) && match cf.cf_kind with Method _ -> true | _ -> false) (ctx.rcf_ft.map_base_classfields cl map_fn) in - - cl.cl_ordered_fields <- cl.cl_ordered_fields @ all_cfs; - List.iter (fun cf -> - cl.cl_fields <- PMap.add cf.cf_name cf cl.cl_fields - ) all_cfs; - - List.iter (fun cf -> - add_class_field_flag cf CfOverride - ) cl.cl_ordered_fields - -let implement_closure_cl ctx cl = - let pos = cl.cl_pos in - let gen = ctx.rcf_gen in - let basic = gen.gcon.basic in - - let field_args, _ = field_type_args ctx pos in - let obj_arg = alloc_var "target" (TInst(ctx.rcf_object_iface, [])) in - - let this_t = TInst(cl, extract_param_types cl.cl_params) in - let this = { eexpr = TConst(TThis); etype = this_t ; epos = pos } in - let mk_this field t = { (mk_field_access gen this field pos) with etype = t } in - - let tf_args = field_args @ [obj_arg, None] in - let cfs, ctor_body = List.fold_left (fun (acc_cf,acc_expr) (v,_) -> - let cf = mk_class_field v.v_name v.v_type false pos (Var { v_read = AccNormal; v_write = AccNormal } ) [] in - let expr = { eexpr = TBinop(Ast.OpAssign, mk_this v.v_name v.v_type, mk_local v pos); etype = v.v_type; epos = pos } in - (cf :: acc_cf, expr :: acc_expr) - ) ([], []) tf_args in - - let map_fn arity ret vars api = - let this_obj = mk_this "target" (TInst(ctx.rcf_object_iface, [])) in - - let rec loop i acc = - if i < 0 then - acc - else - let obj = api i t_dynamic None in - loop (i - 1) (obj :: acc) - in - - let call_arg = if arity = (-1) then - api (-1) t_dynamic None - else if arity = 0 then - null (gen.gclasses.nativearray t_empty) pos - else - mk_nativearray_decl gen t_empty (loop (arity - 1) []) pos - in - - let expr = { - eexpr = TCall( - mk_field_access gen this_obj (mk_internal_name "hx" "invokeField") pos, - (List.map (fun (v,_) -> mk_this v.v_name v.v_type) field_args) @ [ call_arg ] - ); - etype = t_dynamic; - epos = pos - } in - - let expr = if like_float ret && not (like_int ret) then mk_cast ret expr else expr in - - mk_return expr - in - - let all_cfs = List.filter (fun cf -> cf.cf_name <> "new" && match cf.cf_kind with Method _ -> true | _ -> false) (ctx.rcf_ft.map_base_classfields cl map_fn) in - - List.iter (fun cf -> - add_class_field_flag cf CfOverride - ) all_cfs; - let all_cfs = cfs @ all_cfs in - - cl.cl_ordered_fields <- cl.cl_ordered_fields @ all_cfs; - List.iter (fun cf -> - cl.cl_fields <- PMap.add cf.cf_name cf cl.cl_fields - ) all_cfs; - - let ctor_t = TFun(fun_args tf_args, basic.tvoid) in - let ctor_cf = mk_class_field "new" ctor_t true pos (Method MethNormal) [] in - ctor_cf.cf_expr <- Some { - eexpr = TFunction({ - tf_args = tf_args; - tf_type = basic.tvoid; - tf_expr = { eexpr = TBlock({ - eexpr = TCall({ eexpr = TConst(TSuper); etype = TInst(cl,[]); epos = pos }, [make_int ctx.rcf_gen.gcon.basic (-1) pos; make_int ctx.rcf_gen.gcon.basic (-1) pos]); - etype = basic.tvoid; - epos = pos - } :: ctor_body); etype = basic.tvoid; epos = pos } - }); - etype = ctor_t; - epos = pos - }; - - cl.cl_constructor <- Some ctor_cf; - - let closure_fun eclosure e field is_static = - let f = make_string gen.gcon.basic field eclosure.epos in - let args = if ctx.rcf_optimize then [ f; { eexpr = TConst(TInt (hash_field_i32 ctx eclosure.epos field)); etype = basic.tint; epos = eclosure.epos } ] else [ f ] in - let args = args @ [ mk_cast (TInst(ctx.rcf_object_iface, [])) e ] in - - { eclosure with eexpr = TNew(cl,[],args) } - in - closure_fun - -let get_closure_func ctx closure_cl = - let gen = ctx.rcf_gen in - let basic = gen.gcon.basic in - let closure_func eclosure e field is_static = - mk_cast eclosure.etype { eclosure with - eexpr = TNew(closure_cl, [], [ - e; - make_string gen.gcon.basic field eclosure.epos - ] @ ( - if ctx.rcf_optimize then [ { eexpr = TConst(TInt (hash_field_i32 ctx eclosure.epos field)); etype = basic.tint; epos = eclosure.epos } ] else [] - )); - etype = TInst(closure_cl,[]) - } - in - closure_func - -(* - main expr -> field expr -> field string -> possible set expr -> should_throw_exceptions -> changed expression - - Changes a get / set - * - mutable rcf_on_getset_field : texpr->texpr->string->texpr option->bool->texpr;*) - -let configure_dynamic_field_access ctx = - let gen = ctx.rcf_gen in - let is_dynamic fexpr field = - match (field_access_esp gen (gen.greal_type fexpr.etype) field) with - | FEnumField _ - | FClassField _ -> false - | _ -> true - in - - let maybe_hash = if ctx.rcf_optimize then fun str pos -> Some (hash_field_i32 ctx pos str) else fun str pos -> None in - DynamicFieldAccess.configure gen is_dynamic - (fun expr fexpr field set is_unsafe -> - let hash = maybe_hash field fexpr.epos in - ctx.rcf_on_getset_field expr fexpr field hash set is_unsafe - ) - (fun ecall fexpr field call_list -> - let hash = maybe_hash field fexpr.epos in - ctx.rcf_on_call_field ecall fexpr field hash call_list - ); - () - - -(* ******************************************* *) -(* UniversalBaseClass *) -(* ******************************************* *) -(* - Sets the universal base class for hxgen types (HxObject / IHxObject) - - dependencies: - As a rule, it should be one of the last module filters to run so any @:hxgen class created in the process - -Should- only run after RealTypeParams.Modf -*) -module UniversalBaseClass = -struct - let name = "rcf_universal_base_class" - let priority = min_dep +. 10. - - let configure gen baseclass baseinterface basedynamic = - let run md = - if is_hxgen md then - match md with - | TClassDecl cl when (has_class_flag cl CInterface) && cl.cl_path <> baseclass.cl_path && cl.cl_path <> baseinterface.cl_path && cl.cl_path <> basedynamic.cl_path -> - cl.cl_implements <- (baseinterface, []) :: cl.cl_implements - | TClassDecl ({ cl_kind = KAbstractImpl _ | KModuleFields _ }) -> - (* don't add any base classes to abstract implementations and module field containers *) - () - | TClassDecl ({ cl_super = None } as cl) when cl.cl_path <> baseclass.cl_path && cl.cl_path <> baseinterface.cl_path && cl.cl_path <> basedynamic.cl_path -> - cl.cl_super <- Some (baseclass,[]) - | TClassDecl ({ cl_super = Some(super,_) } as cl) when cl.cl_path <> baseclass.cl_path && cl.cl_path <> baseinterface.cl_path && not (is_hxgen (TClassDecl super)) -> - cl.cl_implements <- (baseinterface, []) :: cl.cl_implements - | _ -> - () - in - let map md = run md; md in - gen.gmodule_filters#add name (PCustom priority) map -end;; - - -(* - Priority: must run AFTER UniversalBaseClass -*) -let priority = solve_deps name [DAfter UniversalBaseClass.priority] - -let has_field_override cl name = - try - let cf = PMap.find name cl.cl_fields in - add_class_field_flag cf CfOverride; - true - with | Not_found -> - false - -let configure ctx baseinterface ~slow_invoke = - let run md = - (match md with - | TClassDecl cl when not (has_class_flag cl CExtern) && is_hxgen md && ( not (has_class_flag cl CInterface) || cl.cl_path = baseinterface.cl_path ) && (match cl.cl_kind with KAbstractImpl _ | KModuleFields _ -> false | _ -> true) -> - if is_some cl.cl_super then begin - ignore (has_field_override cl (mk_internal_name "hx" "setField")); - ignore (has_field_override cl (mk_internal_name "hx" "setField_f")); - ignore (has_field_override cl (mk_internal_name "hx" "getField_f")); - end; - - if not (has_field_override cl (mk_internal_name "hx" "lookupField")) then implement_final_lookup ctx cl; - if not (has_field_override cl (mk_internal_name "hx" "getField")) then implement_get_set ctx cl; - if not (has_field_override cl (mk_internal_name "hx" "invokeField")) then implement_invokeField ctx slow_invoke cl; - if not (has_field_override cl (mk_internal_name "hx" "getFields")) then implement_getFields ctx cl; - | _ -> ()); - md - in - ctx.rcf_gen.gmodule_filters#add name (PCustom priority) run diff --git a/src/codegen/gencommon/renameTypeParameters.ml b/src/codegen/gencommon/renameTypeParameters.ml deleted file mode 100644 index dd3e0cbfbf6..00000000000 --- a/src/codegen/gencommon/renameTypeParameters.ml +++ /dev/null @@ -1,95 +0,0 @@ -(* - The Haxe Compiler - Copyright (C) 2005-2019 Haxe Foundation - - This program is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License - as published by the Free Software Foundation; either version 2 - of the License, or (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. -*) -open Type - -(* ******************************************* *) -(* Rename Type Parameters *) -(* ******************************************* *) -(* - This module should run after everything is already applied, - it will look for possible type parameter name clashing and change the classes names to a -*) -let run types = - let i = ref 0 in - let found_types = ref PMap.empty in - let check_type name on_changed = - let rec loop name = - incr i; - let changed_name = (name ^ (string_of_int !i)) in - if PMap.mem changed_name !found_types then loop name else changed_name - in - if PMap.mem name !found_types then begin - let new_name = loop name in - found_types := PMap.add new_name true !found_types; - on_changed new_name - end else found_types := PMap.add name true !found_types - in - - let iter_types tp = - let cls = tp.ttp_class in - let orig = cls.cl_path in - check_type (snd orig) (fun name -> cls.cl_path <- (fst orig, name)) - in - - let save_params save params = - List.fold_left (fun save tp -> - let cls = tp.ttp_class in - (cls.cl_path,tp.ttp_class) :: save) save params - in - - List.iter (function - | TClassDecl cl -> - i := 0; - - let save = [] in - - found_types := PMap.empty; - let save = save_params save cl.cl_params in - List.iter iter_types cl.cl_params; - let cur_found_types = !found_types in - let save = ref save in - List.iter (fun cf -> - found_types := cur_found_types; - save := save_params !save cf.cf_params; - List.iter iter_types cf.cf_params - ) (cl.cl_ordered_fields @ cl.cl_ordered_statics); - - if !save <> [] then begin - let save = !save in - let res = cl.cl_restore in - cl.cl_restore <- (fun () -> - res(); - List.iter (fun (path,t) -> - let cls = t in - cls.cl_path <- path) save - ); - end - - | TEnumDecl ( ({ e_params = hd :: tl }) ) -> - i := 0; - found_types := PMap.empty; - List.iter iter_types (hd :: tl) - - | TAbstractDecl { a_params = hd :: tl } -> - i := 0; - found_types := PMap.empty; - List.iter iter_types (hd :: tl) - - | _ -> () - ) types diff --git a/src/codegen/gencommon/setHXGen.ml b/src/codegen/gencommon/setHXGen.ml deleted file mode 100644 index db1e438e56c..00000000000 --- a/src/codegen/gencommon/setHXGen.ml +++ /dev/null @@ -1,101 +0,0 @@ -(* - The Haxe Compiler - Copyright (C) 2005-2019 Haxe Foundation - - This program is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License - as published by the Free Software Foundation; either version 2 - of the License, or (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. -*) -open Common -open Type - -(* ******************************************* *) -(* set hxgen module *) -(* ******************************************* *) -(* - Goes through all module types and adds the @:hxGen or @:nativeGen meta to them. - Basically, everything that is extern is assumed to not be hxgen, unless meta :hxGen is set, - and everything that is not extern is assumed to be hxgen, unless meta :nativeGgen is set. -*) - -(* - The only option is to run this filter eagerly, because it must be one of the first filters to run, - since many others depend of it. -*) -let run_filter com types = - let rec is_hxgen md = - match md with - | TClassDecl { cl_kind = KAbstractImpl a } -> - is_hxgen (TAbstractDecl a) - | TClassDecl cl -> - let rec is_hxgen_class (c,_) = - if (has_class_flag c CExtern) then begin - if Meta.has Meta.HxGen c.cl_meta then - true - else - Option.map_default (is_hxgen_class) false c.cl_super || List.exists is_hxgen_class c.cl_implements - end else begin - if Meta.has Meta.NativeChildren c.cl_meta || Meta.has Meta.NativeGen c.cl_meta || Meta.has Meta.Struct c.cl_meta then - Option.map_default is_hxgen_class false c.cl_super || List.exists is_hxgen_class c.cl_implements - else - let rec has_nativec (c,p) = - if is_hxgen_class (c,p) then - false - else if Meta.has Meta.Struct c.cl_meta then begin - com.error ("Struct types cannot be subclassed") c.cl_pos; - true - end else - (Meta.has Meta.NativeChildren c.cl_meta && not (Option.map_default is_hxgen_class false c.cl_super || List.exists is_hxgen_class c.cl_implements)) - || Option.map_default has_nativec false c.cl_super - in - if Option.map_default has_nativec false c.cl_super && not (List.exists is_hxgen_class c.cl_implements) then - false - else - true - end - in - is_hxgen_class (cl,[]) - | TEnumDecl e -> - if e.e_extern then - Meta.has Meta.HxGen e.e_meta - else if Meta.has Meta.NativeGen e.e_meta then - if Meta.has Meta.FlatEnum e.e_meta then - false - else begin - com.error "Only flat enums may be @:nativeGen" e.e_pos; - true - end - else - true - | TAbstractDecl a when Meta.has Meta.CoreType a.a_meta -> - not (Meta.has Meta.NativeGen a.a_meta) - | TAbstractDecl a -> - (match follow a.a_this with - | TInst _ | TEnum _ | TAbstract _ -> - is_hxgen (module_type_of_type (follow a.a_this)) - | _ -> - not (Meta.has Meta.NativeGen a.a_meta)) - | TTypeDecl t -> (* TODO see when would we use this *) - false - in - - let filter md = - let meta = if is_hxgen md then Meta.HxGen else Meta.NativeGen in - match md with - | TClassDecl cl -> cl.cl_meta <- (meta, [], cl.cl_pos) :: cl.cl_meta - | TEnumDecl e -> e.e_meta <- (meta, [], e.e_pos) :: e.e_meta - | TTypeDecl t -> t.t_meta <- (meta, [], t.t_pos) :: t.t_meta - | TAbstractDecl a -> a.a_meta <- (meta, [], a.a_pos) :: a.a_meta - in - - List.iter filter types diff --git a/src/codegen/gencommon/switchToIf.ml b/src/codegen/gencommon/switchToIf.ml deleted file mode 100644 index cb044ae9c37..00000000000 --- a/src/codegen/gencommon/switchToIf.ml +++ /dev/null @@ -1,167 +0,0 @@ -(* - The Haxe Compiler - Copyright (C) 2005-2019 Haxe Foundation - - This program is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License - as published by the Free Software Foundation; either version 2 - of the License, or (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. -*) -open Common -open Type -open Gencommon - -(* ******************************************* *) -(* SwitchToIf *) -(* ******************************************* *) -(* - A syntax filter which changes switch expressions to if() else if() else if() ... - - Also it handles switches on native enums (which are not converted to classes) by - rewriting the switch expression to what's supported directly by the targets. -*) -let name = "switch_to_if" -let priority = solve_deps name [] - -let rec simplify_expr e = - match e.eexpr with - | TParenthesis e | TMeta (_, e) -> simplify_expr e - | _ -> e - -let configure gen (should_convert:texpr->bool) = - let basic = gen.gcon.basic in - let rec run e = - match e.eexpr with - | TSwitch ({switch_subject = cond;switch_cases = cases;switch_default = default} as switch) when should_convert e -> - let cond_etype, should_cache = - match gen.gfollow#run_f cond.etype with - | TAbstract ({ a_path = [], "Null" }, [t]) -> - let rec take_off_nullable t = - match gen.gfollow#run_f t with - | TAbstract ({ a_path = [], "Null" }, [t]) -> take_off_nullable t - | _ -> t - in - take_off_nullable t, true - | _ -> - cond.etype, false - in - - if should_cache && not (should_convert { e with eexpr = TSwitch {switch with switch_subject = { cond with etype = cond_etype }}}) then begin - let switch = { switch with - switch_subject = mk_cast cond_etype (run cond); - switch_cases = List.map (fun case -> {case_patterns = List.map run case.case_patterns;case_expr = run case.case_expr}) cases; - switch_default = Option.map run default; - } in - { e with eexpr = TSwitch switch } - end else begin - let local, fst_block = - match cond.eexpr, should_cache with - | TLocal _, false -> - cond, [] - | _ -> - let var = mk_temp "switch" cond_etype in - let cond = run cond in - let cond = if should_cache then mk_cast cond_etype cond else cond in - mk_local var cond.epos, [ mk (TVar (var,Some cond)) basic.tvoid cond.epos ] - in - - let mk_eq cond = - mk (TBinop (Ast.OpEq, local, cond)) basic.tbool cond.epos - in - - let rec mk_many_cond conds = - match conds with - | cond :: [] -> - mk_eq cond - | cond :: tl -> - mk (TBinop (Ast.OpBoolOr, mk_eq (run cond), mk_many_cond tl)) basic.tbool cond.epos - | [] -> - Globals.die "" __LOC__ - in - - let mk_many_cond conds = - let ret = mk_many_cond conds in - (* - this might be considered a hack. But since we're on a syntax filter and - the condition is guaranteed to not have run twice, we can really run the - expr filters again for it (to change e.g. OpEq accordingly) - *) - gen.gexpr_filters#run ret - in - - let rec loop cases = - match cases with - | {case_patterns = conds;case_expr = e} :: [] -> - mk (TIf (mk_many_cond conds, run e, Option.map run default)) e.etype e.epos - | {case_patterns = conds;case_expr = e} :: tl -> - mk (TIf (mk_many_cond conds, run e, Some (loop tl))) e.etype e.epos - | [] -> - match default with - | None -> - raise Exit - | Some d -> - run d - in - - try - { e with eexpr = TBlock (fst_block @ [loop cases]) } - with Exit -> - { e with eexpr = TBlock [] } - end - - (* - Convert a switch on a non-class enum (e.g. native enums) to the native switch, - effectively chancing `switch enumIndex(e) { case 1: ...; case 2: ...; }` to - `switch e { case MyEnum.A: ...; case MyEnum.B: ...; }`, which is supported natively - by some target languages like Java and C#. - *) - | TSwitch ({switch_subject = cond;switch_cases = cases;switch_default = default} as switch) -> - begin - try - match (simplify_expr cond).eexpr with - | TEnumIndex enum - | TCall ({ eexpr = TField (_, FStatic ({ cl_path = [],"Type" }, { cf_name = "enumIndex" })) }, [enum]) -> - let real_enum = - match enum.etype with - | TEnum (e, _) -> e - | _ -> raise Not_found - in - if Meta.has Meta.Class real_enum.e_meta then - raise Not_found; - - let fields = Hashtbl.create (List.length real_enum.e_names) in - PMap.iter (fun _ ef -> Hashtbl.add fields ef.ef_index ef) real_enum.e_constrs; - - let enum_expr = Texpr.Builder.make_typeexpr (TEnumDecl real_enum) e.epos in - let cases = List.map (fun {case_patterns = patterns; case_expr = body} -> - let patterns = List.map (fun e -> - match e.eexpr with - | TConst (TInt i) -> - let ef = Hashtbl.find fields (Int32.to_int i) in - { e with eexpr = TField (enum_expr, FEnum (real_enum, ef)); etype = TEnum (real_enum, List.map (fun _ -> t_dynamic) real_enum.e_params) } - | _ -> - raise Not_found - ) patterns in - let body = run body in - { case_patterns = patterns;case_expr = body} - ) cases in - let switch = mk_switch enum cases (Option.map run default) switch.switch_exhaustive in - { e with eexpr = TSwitch switch } - | _ -> - raise Not_found - with Not_found -> - Type.map_expr run e - end - | _ -> - Type.map_expr run e - in - gen.gsyntax_filters#add name (PCustom priority) run diff --git a/src/codegen/gencommon/tArrayTransform.ml b/src/codegen/gencommon/tArrayTransform.ml deleted file mode 100644 index 60e36304e58..00000000000 --- a/src/codegen/gencommon/tArrayTransform.ml +++ /dev/null @@ -1,104 +0,0 @@ -(* - The Haxe Compiler - Copyright (C) 2005-2019 Haxe Foundation - - This program is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License - as published by the Free Software Foundation; either version 2 - of the License, or (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. -*) -open Common -open Ast -open Type -open Gencommon - -(* ******************************************* *) -(* Dynamic TArray Handling *) -(* ******************************************* *) -(* - In some languages you cannot overload the [] operator, - so we need to decide what is kept as TArray and what gets mapped. - - depends on: - (syntax) must run before expression/statment normalization because it may generate complex expressions - (ok) must run before binop transformations because it may generate some untreated binop ops - (ok) must run before dynamic field access is transformed into reflection -*) -let name = "dyn_tarray" -let priority = solve_deps name [DBefore DynamicOperators.priority; DBefore DynamicFieldAccess.priority] - -(* should change signature: tarray expr -> binop operation -> should change? *) -let configure gen (should_change:texpr->Ast.binop option->bool) (get_fun:string) (set_fun:string) = - let basic = gen.gcon.basic in - let mk_get e e1 e2 = - let efield = mk_field_access gen e1 get_fun e.epos in - { e with eexpr = TCall(efield, [e2]) } - in - let mk_set e e1 e2 evalue = - let efield = mk_field_access gen e1 set_fun e.epos in - { e with eexpr = TCall(efield, [e2; evalue]) } - in - let rec run e = - match e.eexpr with - | TArray(e1, e2) -> - (* e1 should always be a var; no need to map there *) - if should_change e None then mk_get e (run e1) (run e2) else Type.map_expr run e - | TBinop (Ast.OpAssign, ({ eexpr = TArray(e1a,e2a) } as earray), evalue) when should_change earray (Some Ast.OpAssign) -> - mk_set e (run e1a) (run e2a) (run evalue) - | TBinop (Ast.OpAssignOp op,({ eexpr = TArray(e1a,e2a) } as earray) , evalue) when should_change earray (Some (Ast.OpAssignOp op)) -> - (* cache all arguments in vars so they don't get executed twice *) - (* let ensure_local gen block name e = *) - let block = ref [] in - - let arr_local = ensure_local gen.gcon block "array" (run e1a) in - let idx_local = ensure_local gen.gcon block "index" (run e2a) in - block := (mk_set e arr_local idx_local ( { e with eexpr=TBinop(op, mk_get earray arr_local idx_local, run evalue) } )) :: !block; - - { e with eexpr = TBlock (List.rev !block) } - | TUnop(op, flag, ({ eexpr = TArray(e1a, e2a) } as earray)) -> - if should_change earray None && match op with | Not | Neg -> false | _ -> true then begin - - let block = ref [] in - - let actual_t = match op with - | Ast.Increment | Ast.Decrement -> (match follow earray.etype with - | TInst _ | TAbstract _ | TEnum _ -> earray.etype - | _ -> basic.tfloat) - | Ast.Not -> basic.tbool - | _ -> basic.tint - in - - let val_v = mk_temp "arrVal" actual_t in - let ret_v = mk_temp "arrRet" actual_t in - - let arr_local = ensure_local gen.gcon block "arr" (run e1a) in - let idx_local = ensure_local gen.gcon block "arrIndex" (run e2a) in - - let val_local = { earray with eexpr = TLocal(val_v) } in - let ret_local = { earray with eexpr = TLocal(ret_v) } in - (* var idx = 1; var val = x._get(idx); var ret = val++; x._set(idx, val); ret; *) - block := { eexpr = TVar(val_v, Some(mk_get earray arr_local idx_local)); (* var val = x._get(idx) *) - etype = gen.gcon.basic.tvoid; - epos = e2a.epos - } :: !block; - block := { eexpr = TVar(ret_v, Some { e with eexpr = TUnop(op, flag, val_local) }); (* var ret = val++ *) - etype = gen.gcon.basic.tvoid; - epos = e2a.epos - } :: !block; - block := (mk_set e arr_local idx_local val_local) (*x._set(idx,val)*) :: !block; - block := ret_local :: !block; - { e with eexpr = TBlock (List.rev !block) } - end else - Type.map_expr run e - | _ -> Type.map_expr run e - in - gen.gexpr_filters#add "dyn_tarray" (PCustom priority) run diff --git a/src/codegen/gencommon/unnecessaryCastsRemoval.ml b/src/codegen/gencommon/unnecessaryCastsRemoval.ml deleted file mode 100644 index f7093869f34..00000000000 --- a/src/codegen/gencommon/unnecessaryCastsRemoval.ml +++ /dev/null @@ -1,64 +0,0 @@ -(* - The Haxe Compiler - Copyright (C) 2005-2019 Haxe Foundation - - This program is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License - as published by the Free Software Foundation; either version 2 - of the License, or (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. -*) -open Gencommon -open Type - -(* - This module will take care of simplifying unnecessary casts, specially those made by the compiler - when inlining. Right now, it will only take care of casts used as a statement, which are always useless; - - TODO: Take care of more cases, e.g. when the to and from types are the same - - dependencies: - This must run after CastDetection, but before ExpressionUnwrap -*) -let rec take_off_cast run e = - match e.eexpr with - | TCast (c, _) -> take_off_cast run c - | _ -> run e - -let rec traverse e = - match e.eexpr with - | TBlock bl -> - let bl = List.map (take_off_cast traverse) bl in - { e with eexpr = TBlock bl } - | TTry (block, catches) -> - { e with eexpr = TTry(traverse (mk_block block), List.map (fun (v,block) -> (v, traverse (mk_block block))) catches) } - | TSwitch switch -> - let switch = { switch with - switch_cases = List.map (fun case -> { case with case_expr = traverse (mk_block e)}) switch.switch_cases; - switch_default = Option.map (fun e -> traverse (mk_block e)) switch.switch_default; - } in - { e with eexpr = TSwitch switch } - | TWhile (cond,block,flag) -> - {e with eexpr = TWhile(cond,traverse (mk_block block), flag) } - | TIf (cond, eif, eelse) -> - { e with eexpr = TIf(cond, traverse (mk_block eif), Option.map (fun e -> traverse (mk_block e)) eelse) } - | TFor (v,it,block) -> - { e with eexpr = TFor(v,it, traverse (mk_block block)) } - | TFunction (tfunc) -> - { e with eexpr = TFunction({ tfunc with tf_expr = traverse (mk_block tfunc.tf_expr) }) } - | _ -> - e (* if expression doesn't have a block, we will exit *) - -let name = "casts_removal" -let priority = solve_deps name [DAfter CastDetect.priority; DBefore ExpressionUnwrap.priority] - -let configure gen = - gen.gsyntax_filters#add name (PCustom priority) traverse diff --git a/src/codegen/gencommon/unreachableCodeEliminationSynf.ml b/src/codegen/gencommon/unreachableCodeEliminationSynf.ml deleted file mode 100644 index 6d41a901e57..00000000000 --- a/src/codegen/gencommon/unreachableCodeEliminationSynf.ml +++ /dev/null @@ -1,219 +0,0 @@ -(* - The Haxe Compiler - Copyright (C) 2005-2019 Haxe Foundation - - This program is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License - as published by the Free Software Foundation; either version 2 - of the License, or (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. -*) -open Ast -open Type -open Gencommon - -(* - In some source code platforms, the code won't compile if there is Unreachable code, so this filter will take off any unreachable code. - If the parameter "handle_switch_break" is set to true, it will already add a "break" statement on switch cases when suitable; - in order to not confuse with while break, it will be a special expression __sbreak__ - If the parameter "handle_not_final_returns" is set to true, it will also add final returns when functions are detected to be lacking of them. - (Will respect __fallback__ expressions) - If the parameter "java_mode" is set to true, some additional checks following the java unreachable specs - (http://docs.oracle.com/javase/specs/jls/se7/html/jls-14.html#jls-14.21) will be added - - dependencies: - This must run before SwitchBreakSynf (see SwitchBreakSynf dependecy value) - This must be the LAST syntax filter to run. It expects ExpressionUnwrap to have run correctly, since this will only work for source-code based targets -*) -type uexpr_kind = - | Normal - | BreaksLoop - | BreaksFunction - -let aggregate_kind e1 e2 = - match e1, e2 with - | Normal, _ - | _, Normal -> Normal - | BreaksLoop, _ - | _, BreaksLoop -> BreaksLoop - | BreaksFunction, BreaksFunction -> BreaksFunction - -let aggregate_constant op c1 c2= - match op, c1, c2 with - | OpEq, Some v1, Some v2 -> Some (TBool (v1 = v2)) - | OpNotEq, Some v1, Some v2 -> Some (TBool (v1 <> v2)) - | OpBoolOr, Some (TBool v1) , Some (TBool v2) -> Some (TBool (v1 || v2)) - | OpBoolAnd, Some (TBool v1) , Some (TBool v2) -> Some (TBool (v1 && v2)) - | OpAssign, _, Some v2 -> Some v2 - | _ -> None - -let rec get_constant_expr e = - match e.eexpr with - | TConst (v) -> Some v - | TBinop(op, v1, v2) -> aggregate_constant op (get_constant_expr v1) (get_constant_expr v2) - | TParenthesis(e) | TMeta(_,e) -> get_constant_expr e - | _ -> None - -let init gen java_mode = - let should_warn = false in - - let do_warn = - if should_warn then gen.gwarning WGenerator "Unreachable code" else (fun pos -> ()) - in - - let return_loop expr kind = - match kind with - | Normal | BreaksLoop -> expr, Normal - | _ -> expr, kind - in - - let mk_sbreak = mk (TIdent "__sbreak__") t_dynamic in - - let rec has_fallback expr = match expr.eexpr with - | TBlock(bl) -> (match List.rev bl with - | { eexpr = TIdent "__fallback__" } :: _ -> true - | ({ eexpr = TBlock(_) } as bl) :: _ -> has_fallback bl - | _ -> false) - | TIdent "__fallback__" -> true - | _ -> false - in - - let handle_case = fun (expr,kind) -> - match kind with - | Normal when has_fallback expr -> expr - | Normal -> Type.concat expr (mk_sbreak expr.epos) - | BreaksLoop | BreaksFunction -> expr - in - - let has_break = ref false in - - let rec process_expr expr = - match expr.eexpr with - | TMeta (m,expr) -> - let expr,kind = process_expr expr in - { expr with eexpr = TMeta (m, expr) }, kind - | TReturn _ | TThrow _ -> expr, BreaksFunction - | TContinue -> expr, BreaksLoop - | TBreak -> has_break := true; expr, BreaksLoop - | TCall( { eexpr = TIdent "__goto__" }, _ ) -> expr, BreaksLoop - - | TBlock bl -> - let new_block = ref [] in - let is_unreachable = ref false in - let ret_kind = ref Normal in - - List.iter (fun e -> - if !is_unreachable then - do_warn e.epos - else begin - let changed_e, kind = process_expr e in - new_block := changed_e :: !new_block; - match kind with - | BreaksLoop | BreaksFunction -> - ret_kind := kind; - is_unreachable := true - | _ -> () - end - ) bl; - - { expr with eexpr = TBlock(List.rev !new_block) }, !ret_kind - | TFunction tf -> - let changed, kind = process_expr tf.tf_expr in - let changed = if not (ExtType.is_void tf.tf_type) && kind <> BreaksFunction then - Type.concat changed (Texpr.Builder.mk_return (null tf.tf_type expr.epos)) - else - changed - in - - { expr with eexpr = TFunction({ tf with tf_expr = changed }) }, Normal - | TFor(var, cond, block) -> - let last_has_break = !has_break in - has_break := false; - - let changed_block, _ = process_expr block in - has_break := last_has_break; - let expr = { expr with eexpr = TFor(var, cond, changed_block) } in - return_loop expr Normal - | TIf(cond, eif, None) -> - if java_mode then - match get_constant_expr cond with - | Some (TBool true) -> - process_expr eif - | _ -> - { expr with eexpr = TIf(cond, fst (process_expr eif), None) }, Normal - else - { expr with eexpr = TIf(cond, fst (process_expr eif), None) }, Normal - | TIf(cond, eif, Some eelse) -> - let eif, eif_k = process_expr eif in - let eelse, eelse_k = process_expr eelse in - let k = aggregate_kind eif_k eelse_k in - { expr with eexpr = TIf(cond, eif, Some eelse) }, k - | TWhile(cond, block, flag) -> - let last_has_break = !has_break in - has_break := false; - - let block, k = process_expr block in - if java_mode then - match get_constant_expr cond, flag, !has_break with - | Some (TBool true), _, false -> - has_break := last_has_break; - { expr with eexpr = TWhile(cond, block, flag) }, BreaksFunction - | Some (TBool false), NormalWhile, _ -> - has_break := last_has_break; - do_warn expr.epos; - null expr.etype expr.epos, Normal - | _ -> - has_break := last_has_break; - return_loop { expr with eexpr = TWhile(cond,block,flag) } Normal - else begin - has_break := last_has_break; - return_loop { expr with eexpr = TWhile(cond,block,flag) } Normal - end - | TSwitch ({switch_default = None} as switch) -> - let switch = { switch with - switch_cases = List.map (fun case -> {case with case_expr = handle_case (process_expr case.case_expr)}) switch.switch_cases; - switch_default = None; - } in - { expr with eexpr = TSwitch switch }, Normal - | TSwitch ({switch_default = Some def} as switch) -> - let def, k = process_expr def in - let def = handle_case (def, k) in - let k = ref k in - let switch = { switch with - switch_cases = List.map (fun case -> - let e, ek = process_expr case.case_expr in - k := aggregate_kind !k ek; - {case with case_expr = handle_case (e, ek)} - ) switch.switch_cases; - switch_default = Some def; - } in - let ret = { expr with eexpr = TSwitch switch } in - ret, !k - | TTry (e, catches) -> - let e, k = process_expr e in - let k = ref k in - let ret = { expr with eexpr = TTry(e, List.map (fun (v, e) -> - let e, ek = process_expr e in - k := aggregate_kind !k ek; - (v, e) - ) catches) } in - ret, !k - | _ -> expr, Normal - in - - let run e = fst (process_expr e) in - run - -let priority = min_dep -. 100.0 - -let configure gen java_mode = - let run = init gen java_mode in - gen.gsyntax_filters#add "unreachable_synf" (PCustom priority) run diff --git a/src/codegen/jClass.ml b/src/codegen/jClass.ml new file mode 100644 index 00000000000..5a08b4011ae --- /dev/null +++ b/src/codegen/jClass.ml @@ -0,0 +1,79 @@ +open Globals + +type jwildcard = + | WExtends (* + *) + | WSuper (* - *) + | WNone + +type jtype_argument = + | TType of jwildcard * jsignature + | TAny (* * *) + +and jsignature = + | TByte (* B *) + | TChar (* C *) + | TDouble (* D *) + | TFloat (* F *) + | TInt (* I *) + | TLong (* J *) + | TShort (* S *) + | TBool (* Z *) + | TObject of path * jtype_argument list (* L Classname *) + | TObjectInner of (string list) * (string * jtype_argument list) list (* L Classname ClassTypeSignatureSuffix *) + | TArray of jsignature * int option (* [ *) + | TMethod of jmethod_signature (* ( *) + | TTypeParameter of string (* T *) + +(* ( jsignature list ) ReturnDescriptor (| V | jsignature) *) +and jmethod_signature = jsignature list * jsignature option + +type jtypes = (string * jsignature option * jsignature list) list + +type jannotation = { + ann_type : jsignature; + ann_elements : (string * jannotation_value) list; +} + +and jannotation_value = + | ValConst of jsignature * int + | ValEnum of jsignature * string (* e *) + | ValClass of jsignature (* c *) (* V -> Void *) + | ValAnnotation of jannotation (* @ *) + | ValArray of jannotation_value list (* [ *) + +type jlocal = { + ld_start_pc : int; + ld_length : int; + ld_name : string; + ld_descriptor : string; + ld_index : int; +} + +type jattribute = + | AttrCode of jattribute list + | AttrDeprecated + | AttrLocalVariableTable of jlocal list + | AttrMethodParameters of (string * int) list + | AttrSignature of string + | AttrVisibleAnnotations of jannotation list + | AttrOther + +type jfield = { + jf_name : string; + jf_flags : int; + jf_types : jtypes; + jf_descriptor : jsignature; + jf_attributes : jattribute list; + jf_code : jattribute list option; +} + +type jclass = { + jc_path : path; + jc_flags : int; + jc_super : jsignature; + jc_interfaces : jsignature list; + jc_types : jtypes; + jc_fields : jfield list; + jc_methods : jfield list; + jc_attributes : jattribute list; +} \ No newline at end of file diff --git a/src/codegen/java.ml b/src/codegen/java.ml deleted file mode 100644 index dfdfd492e3a..00000000000 --- a/src/codegen/java.ml +++ /dev/null @@ -1,1281 +0,0 @@ -(* - The Haxe Compiler - Copyright (C) 2005-2019 Haxe Foundation - - This program is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License - as published by the Free Software Foundation; either version 2 - of the License, or (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. -*) -open Unix -open ExtString -open NativeLibraries -open Common -open Globals -open Ast -open JData - -(** Java lib *) - -module SS = Set.Make(String) - -type java_lib_ctx = { - jcom : Common.context; - (* current tparams context *) - mutable jtparams : jtypes list; - is_std : bool; -} - -exception ConversionError of string * pos - -let error s p = raise (ConversionError (s, p)) - -let is_haxe_keyword = function - | "cast" | "extern" | "function" | "in" | "typedef" | "using" | "var" | "untyped" | "inline" -> true - | _ -> false - -let jname_to_hx name = - let name = - if name <> "" && (String.get name 0 < 'A' || String.get name 0 > 'Z') then - Char.escaped (Char.uppercase_ascii (String.get name 0)) ^ String.sub name 1 (String.length name - 1) - else - name - in - let name = String.concat "__" (String.nsplit name "_") in - String.map (function | '$' -> '_' | c -> c) name - -let normalize_pack pack = - List.map (function - | "" -> "" - | str when String.get str 0 >= 'A' && String.get str 0 <= 'Z' -> - String.lowercase str - | str -> str - ) pack - -let jpath_to_hx (pack,name) = match pack, name with - | ["haxe";"root"], name -> [], name - | "com" :: ("oracle" | "sun") :: _, _ - | "javax" :: _, _ - | "org" :: ("ietf" | "jcp" | "omg" | "w3c" | "xml") :: _, _ - | "sun" :: _, _ - | "sunw" :: _, _ -> "java" :: normalize_pack pack, jname_to_hx name - | pack, name -> normalize_pack pack, jname_to_hx name - -let real_java_path ctx (pack,name) = - s_type_path (pack, name) - -let lookup_jclass com path = - let path = jpath_to_hx path in - List.fold_right (fun java_lib acc -> - match acc with - | None -> java_lib#lookup path - | Some p -> Some p - ) com.native_libs.java_libs None - -let mk_type_path ctx path params p = - let name, sub = try - let p, _ = String.split (snd path) "$" in - jname_to_hx p, Some (jname_to_hx (snd path)) - with | Invalid_string -> - jname_to_hx (snd path), None - in - let pack = fst (jpath_to_hx path) in - let pack, sub, name = match path with - | [], ("Float" as c) - | [], ("Int" as c) - | [], ("Single" as c) - | [], ("Bool" as c) - | [], ("Dynamic" as c) - | [], ("Iterator" as c) - | [], ("ArrayAccess" as c) - | [], ("Iterable" as c) -> - [], Some c, "StdTypes" - | [], ("String" as c) -> - ["std"], None, c - | _ -> - pack, sub, name - in - make_ptp_ct { - tpackage = pack; - tname = name; - tparams = params; - tsub = sub; - } p - -let has_tparam name params = List.exists(fun (n,_,_) -> n = name) params - -let rec convert_arg ctx p arg = - match arg with - | TAny | TType (WSuper, _) -> TPType (mk_type_path ctx ([], "Dynamic") [] p,null_pos) - | TType (_, jsig) -> TPType (convert_signature ctx p jsig,null_pos) - -and convert_signature ctx p jsig = - match jsig with - | TByte -> mk_type_path ctx (["java"; "types"], "Int8") [] p - | TChar -> mk_type_path ctx (["java"; "types"], "Char16") [] p - | TDouble -> mk_type_path ctx ([], "Float") [] p - | TFloat -> mk_type_path ctx ([], "Single") [] p - | TInt -> mk_type_path ctx ([], "Int") [] p - | TLong -> mk_type_path ctx (["haxe"], "Int64") [] p - | TShort -> mk_type_path ctx (["java"; "types"], "Int16") [] p - | TBool -> mk_type_path ctx ([], "Bool") [] p - | TObject ( (["haxe";"root"], name), args ) -> mk_type_path ctx ([], name) (List.map (convert_arg ctx p) args) p - (** nullable types *) - (* replaced from Null to the actual abstract type to fix #2738 *) - (* | TObject ( (["java";"lang"], "Integer"), [] ) -> mk_type_path ctx ([], "Null") [ TPType (mk_type_path ctx ([], "Int") []) ] *) - (* | TObject ( (["java";"lang"], "Double"), [] ) -> mk_type_path ctx ([], "Null") [ TPType (mk_type_path ctx ([], "Float") []) ] *) - (* | TObject ( (["java";"lang"], "Float"), [] ) -> mk_type_path ctx ([], "Null") [ TPType (mk_type_path ctx ([], "Single") []) ] *) - (* | TObject ( (["java";"lang"], "Boolean"), [] ) -> mk_type_path ctx ([], "Null") [ TPType (mk_type_path ctx ([], "Bool") []) ] *) - (* | TObject ( (["java";"lang"], "Byte"), [] ) -> mk_type_path ctx ([], "Null") [ TPType (mk_type_path ctx (["java";"types"], "Int8") []) ] *) - (* | TObject ( (["java";"lang"], "Character"), [] ) -> mk_type_path ctx ([], "Null") [ TPType (mk_type_path ctx (["java";"types"], "Char16") []) ] *) - (* | TObject ( (["java";"lang"], "Short"), [] ) -> mk_type_path ctx ([], "Null") [ TPType (mk_type_path ctx (["java";"types"], "Int16") []) ] *) - (* | TObject ( (["java";"lang"], "Long"), [] ) -> mk_type_path ctx ([], "Null") [ TPType (mk_type_path ctx (["haxe"], "Int64") []) ] *) - (** other std types *) - | TObject ( (["java";"lang"], "Object"), [] ) -> mk_type_path ctx ([], "Dynamic") [] p - | TObject ( (["java";"lang"], "String"), [] ) -> mk_type_path ctx ([], "String") [] p - | TObject ( (["java";"lang"], "Enum"), [_] ) -> mk_type_path ctx ([], "EnumValue") [] p - (** other types *) - | TObject ( path, [] ) -> - (match lookup_jclass ctx.jcom path with - | Some (jcl, _, _) -> mk_type_path ctx path (List.map (fun _ -> convert_arg ctx p TAny) jcl.ctypes) p - | None -> mk_type_path ctx path [] p) - | TObject ( path, args ) -> mk_type_path ctx path (List.map (convert_arg ctx p) args) p - | TObjectInner (pack, (name, params) :: inners) -> - let actual_param = match List.rev inners with - | (_, p) :: _ -> p - | _ -> die "" __LOC__ in - mk_type_path ctx (pack, name ^ "$" ^ String.concat "$" (List.map fst inners)) (List.map (fun param -> convert_arg ctx p param) actual_param) p - | TObjectInner (pack, inners) -> die "" __LOC__ - | TArray (jsig, _) -> mk_type_path ctx (["java"], "NativeArray") [ TPType (convert_signature ctx p jsig,null_pos) ] p - | TMethod _ -> JReader.error "TMethod cannot be converted directly into Complex Type" - | TTypeParameter s -> (match ctx.jtparams with - | cur :: others -> - if has_tparam s cur then - mk_type_path ctx ([], s) [] p - else begin - if ctx.jcom.verbose && not(List.exists (has_tparam s) others) then print_endline ("Type parameter " ^ s ^ " was not found while building type!"); - mk_type_path ctx ([], "Dynamic") [] p - end - | _ -> - if ctx.jcom.verbose then print_endline ("Empty type parameter stack!"); - mk_type_path ctx ([], "Dynamic") [] p) - -let convert_constant ctx p const = - Option.map_default (function - | ConstString s -> Some (EConst (String(s,SDoubleQuotes)), p) - | ConstInt i -> Some (EConst (Int (Printf.sprintf "%ld" i, None)), p) - | ConstFloat f | ConstDouble f -> Some (EConst (Float (Printf.sprintf "%E" f, None)), p) - | _ -> None) None const - -let convert_constraints ctx p tl = match tl with - | [] -> None - | [t] -> Some (convert_signature ctx p t,null_pos) - | tl -> Some (CTIntersection(List.map (fun t -> convert_signature ctx p t,null_pos) tl),null_pos) - -let convert_param ctx p parent param = - let name, constraints = match param with - | (name, Some extends_sig, implem_sig) -> - name, extends_sig :: implem_sig - | (name, None, implemem_sig) -> - name, implemem_sig - in - { - tp_name = jname_to_hx name,null_pos; - tp_params = []; - tp_constraints = convert_constraints ctx p constraints; - tp_default = None; - tp_meta = []; - } - -let get_type_path ctx ct = match ct with | CTPath ptp -> ptp | _ -> die "" __LOC__ - -let is_override field = - List.exists (function | AttrVisibleAnnotations [{ ann_type = TObject( (["java";"lang"], "Override"), _ ) }] -> true | _ -> false) field.jf_attributes - -let mk_override field = - { field with jf_attributes = ((AttrVisibleAnnotations [{ ann_type = TObject( (["java";"lang"], "Override"), [] ); ann_elements = [] }]) :: field.jf_attributes) } - -let del_override field = - { field with jf_attributes = List.filter (fun a -> not (is_override_attrib a)) field.jf_attributes } - -let get_canonical ctx p pack name = - (Meta.JavaCanonical, [EConst (String (String.concat "." pack,SDoubleQuotes)), p; EConst (String (name,SDoubleQuotes)), p], p) - -let show_in_completion ctx jc = - if not ctx.is_std then true - else match fst jc.cpath with - | ("java" | "javax" | "org") :: _ -> true - | _ -> false - -(** - `haxe.Rest` auto-boxes primitive types. - That means we can't use it as varargs for extern methods. - E.g externs with `int` varargs are represented as `int[]` at run time - while `haxe.Rest` is actually `java.lang.Integer[]`. -*) -let is_eligible_for_haxe_rest_args arg_type = - match arg_type with - | TByte | TChar | TDouble | TFloat | TInt | TLong | TShort | TBool -> false - | _ -> true - -let convert_java_enum ctx p pe = - let meta = ref (get_canonical ctx p (fst pe.cpath) (snd pe.cpath) :: [Meta.Native, [EConst (String (real_java_path ctx pe.cpath,SDoubleQuotes) ), p], p ]) in - let data = ref [] in - List.iter (fun f -> - (* if List.mem JEnum f.jf_flags then *) - match f.jf_vmsignature with - | TObject( path, [] ) when path = pe.cpath && List.mem JStatic f.jf_flags && List.mem JFinal f.jf_flags -> - data := { ec_name = f.jf_name,null_pos; ec_doc = None; ec_meta = []; ec_args = []; ec_pos = p; ec_params = []; ec_type = None; } :: !data; - | _ -> () - ) pe.cfields; - - if not (show_in_completion ctx pe) then meta := (Meta.NoCompletion,[],null_pos) :: !meta; - - EEnum { - d_name = jname_to_hx (snd pe.cpath),null_pos; - d_doc = None; - d_params = []; (* enums never have type parameters *) - d_meta = !meta; - d_flags = [EExtern]; - d_data = List.rev !data; - } - - let convert_java_field ctx p jc is_interface field = - let p = { p with pfile = p.pfile ^" (" ^field.jf_name ^")" } in - let cff_doc = None in - let cff_pos = p in - let cff_meta = ref [] in - let cff_access = ref [] in - let cff_name = match field.jf_name with - | "" -> "new" - | ""-> raise Exit (* __init__ field *) - | name when String.length name > 5 -> - (match String.sub name 0 5 with - | "__hx_" | "this$" -> raise Exit - | _ -> name) - | name -> name - in - let jf_constant = ref field.jf_constant in - let readonly = ref false in - let is_varargs = ref false in - - List.iter (function - | JPublic -> cff_access := (APublic,null_pos) :: !cff_access - | JPrivate -> raise Exit (* private instances aren't useful on externs *) - | JProtected -> - cff_meta := (Meta.Protected, [], p) :: !cff_meta; - cff_access := (APrivate,null_pos) :: !cff_access - | JStatic -> cff_access := (AStatic,null_pos) :: !cff_access - | JFinal -> - cff_access := (AFinal, p) :: !cff_access; - (match field.jf_kind, field.jf_vmsignature, field.jf_constant with - | JKField, TObject _, _ -> - jf_constant := None - | JKField, _, Some _ -> - readonly := true; - jf_constant := None; - | _ -> jf_constant := None) - (* | JSynchronized -> cff_meta := (Meta.Synchronized, [], p) :: !cff_meta *) - | JVolatile -> cff_meta := (Meta.Volatile, [], p) :: !cff_meta - | JTransient -> cff_meta := (Meta.Transient, [], p) :: !cff_meta - | JVarArgs -> is_varargs := true - | JAbstract when not is_interface -> - cff_access := (AAbstract, p) :: !cff_access - | _ -> () - ) field.jf_flags; - - List.iter (function - | AttrDeprecated when jc.cpath <> (["java";"util"],"Date") -> cff_meta := (Meta.Deprecated, [], p) :: !cff_meta - (* TODO: pass anotations as @:meta *) - | AttrVisibleAnnotations ann -> - List.iter (function - | { ann_type = TObject( (["java";"lang"], "Override"), [] ) } -> - cff_access := (AOverride,null_pos) :: !cff_access - | _ -> () - ) ann - | _ -> () - ) field.jf_attributes; - - List.iter (fun jsig -> - match convert_signature ctx p jsig with - | CTPath path -> - let path = path.path in - cff_meta := (Meta.Throws, [Ast.EConst (Ast.String (s_type_path (path.tpackage,path.tname),SDoubleQuotes)), p],p) :: !cff_meta - | _ -> () - ) field.jf_throws; - - let extract_local_names () = - let default i = - "param" ^ string_of_int i - in - match field.jf_code with - | None -> - default - | Some attribs -> try - let rec loop attribs = match attribs with - | AttrLocalVariableTable locals :: _ -> - locals - | _ :: attribs -> - loop attribs - | [] -> - raise Not_found - in - let locals = loop attribs in - let h = Hashtbl.create 0 in - List.iter (fun local -> - Hashtbl.replace h local.ld_index local.ld_name - ) locals; - (fun i -> - try Hashtbl.find h (i - 1) (* they are 1-based *) - with Not_found -> "param" ^ string_of_int i - ) - with Not_found -> - default - in - let kind = match field.jf_kind with - | JKField when !readonly -> - FProp (("default",null_pos), ("null",null_pos), Some (convert_signature ctx p field.jf_signature,null_pos), None) - | JKField -> - FVar (Some (convert_signature ctx p field.jf_signature,null_pos), None) - | JKMethod -> - match field.jf_signature with - | TMethod (args, ret) -> - let local_names = extract_local_names() in - let old_types = ctx.jtparams in - (match ctx.jtparams with - | c :: others -> ctx.jtparams <- (c @ field.jf_types) :: others - | [] -> ctx.jtparams <- field.jf_types :: []); - let i = ref 0 in - let args_count = List.length args in - let args = List.map (fun s -> - incr i; - let hx_sig = - match s with - | TArray (s1,_) when !is_varargs && !i = args_count && is_eligible_for_haxe_rest_args s1 -> - mk_type_path ctx (["haxe"], "Rest") [TPType (convert_signature ctx p s1,null_pos)] p - | _ -> - convert_signature ctx null_pos s - in - (local_names !i,null_pos), false, [], Some(hx_sig,null_pos), None - ) args in - let t = Option.map_default (convert_signature ctx p) (mk_type_path ctx ([], "Void") [] p) ret in - cff_access := (AOverload,p) :: !cff_access; - let types = List.map (function - | (name, Some ext, impl) -> - { - tp_name = name,null_pos; - tp_params = []; - tp_constraints = convert_constraints ctx p (ext :: impl); - tp_default = None; - tp_meta = []; - } - | (name, None, impl) -> - { - tp_name = name,null_pos; - tp_params = []; - tp_constraints = convert_constraints ctx p impl; - tp_default = None; - tp_meta = []; - } - ) field.jf_types in - ctx.jtparams <- old_types; - - FFun ({ - f_params = types; - f_args = args; - f_type = Some (t,null_pos); - f_expr = None - }) - | _ -> error "Method signature was expected" p - in - if field.jf_code <> None && is_interface then cff_meta := (Meta.JavaDefault,[],cff_pos) :: !cff_meta; - let cff_name, cff_meta = - match String.get cff_name 0 with - | '%' -> - let name = (String.sub cff_name 1 (String.length cff_name - 1)) in - if not (is_haxe_keyword name) then - cff_meta := (Meta.Deprecated, [EConst(String( - "This static field `_" ^ name ^ "` is deprecated and will be removed in later versions. Please use `" ^ name ^ "` instead",SDoubleQuotes) - ),p], p) :: !cff_meta; - "_" ^ name, - (Meta.Native, [EConst (String (name,SDoubleQuotes) ), cff_pos], cff_pos) :: !cff_meta - | _ -> - match String.nsplit cff_name "$" with - | [ no_dollar ] -> - cff_name, !cff_meta - | parts -> - String.concat "_" parts, - (Meta.Native, [EConst (String (cff_name,SDoubleQuotes) ), cff_pos], cff_pos) :: !cff_meta - in - if Common.raw_defined ctx.jcom "java_loader_debug" then - Printf.printf "\t%s%sfield %s : %s\n" (if List.mem_assoc AStatic !cff_access then "static " else "") (if List.mem_assoc AOverride !cff_access then "override " else "") cff_name (s_sig field.jf_signature); - - { - cff_name = cff_name,null_pos; - cff_doc = cff_doc; - cff_pos = cff_pos; - cff_meta = cff_meta; - cff_access = !cff_access; - cff_kind = kind - } - - let rec japply_params params jsig = match params with - | [] -> jsig - | _ -> match jsig with - | TTypeParameter s -> (try - List.assoc s params - with | Not_found -> jsig) - | TObject(p,tl) -> - TObject(p, args params tl) - | TObjectInner(sl, stll) -> - TObjectInner(sl, List.map (fun (s,tl) -> (s, args params tl)) stll) - | TArray(s,io) -> - TArray(japply_params params s, io) - | TMethod(sl, sopt) -> - TMethod(List.map (japply_params params) sl, Option.map (japply_params params) sopt) - | _ -> jsig - - and args params tl = match params with - | [] -> tl - | _ -> List.map (function - | TAny -> TAny - | TType(w,s) -> TType(w,japply_params params s)) tl - - let mk_params jtypes = List.map (fun (s,_,_) -> (s,TTypeParameter s)) jtypes - - let convert_java_class ctx p jc = - match List.mem JEnum jc.cflags with - | true -> (* is enum *) - [convert_java_enum ctx p jc] - | false -> - let flags = ref [HExtern] in - if Common.raw_defined ctx.jcom "java_loader_debug" then begin - let sup = jc.csuper :: jc.cinterfaces in - print_endline ("converting " ^ (if List.mem JAbstract jc.cflags then "abstract " else "") ^ JData.path_s jc.cpath ^ " : " ^ (String.concat ", " (List.map s_sig sup))); - end; - (* todo: instead of JavaNative, use more specific definitions *) - let meta = ref [Meta.JavaNative, [], p; Meta.Native, [EConst (String (real_java_path ctx jc.cpath,SDoubleQuotes) ), p], p; get_canonical ctx p (fst jc.cpath) (snd jc.cpath)] in - let force_check = Common.defined ctx.jcom Define.ForceLibCheck in - if not force_check then - meta := (Meta.LibType,[],p) :: !meta; - - let is_interface = ref false in - let is_abstract = ref false in - List.iter (fun f -> match f with - | JFinal -> flags := HFinal :: !flags - | JInterface -> - is_interface := true; - flags := HInterface :: !flags - | JAbstract -> - meta := (Meta.Abstract, [], p) :: !meta; - is_abstract := true; - | JAnnotation -> meta := (Meta.Annotation, [], p) :: !meta - | _ -> () - ) jc.cflags; - - if !is_abstract && not !is_interface then flags := HAbstract :: !flags; - (match jc.csuper with - | TObject( (["java";"lang"], "Object"), _ ) -> () - | TObject( (["haxe";"lang"], "HxObject"), _ ) -> meta := (Meta.HxGen,[],p) :: !meta - | _ -> flags := HExtends (get_type_path ctx (convert_signature ctx p jc.csuper)) :: !flags - ); - - List.iter (fun i -> - match i with - | TObject ( (["haxe";"lang"], "IHxObject"), _ ) -> meta := (Meta.HxGen,[],p) :: !meta - | _ -> flags := - if !is_interface then - HExtends (get_type_path ctx (convert_signature ctx p i)) :: !flags - else - HImplements (get_type_path ctx (convert_signature ctx p i)) :: !flags - ) jc.cinterfaces; - - let fields = ref [] in - let jfields = ref [] in - - if jc.cpath <> (["java";"lang"], "CharSequence") then - List.iter (fun f -> - try - if !is_interface && List.mem JStatic f.jf_flags then - () - else begin - fields := convert_java_field ctx p jc !is_interface f :: !fields; - jfields := f :: !jfields - end - with - | Exit -> () - ) (jc.cfields @ jc.cmethods); - - (* make sure the throws types are imported correctly *) - let imports = List.concat (List.map (fun f -> - List.map (fun jsig -> - match convert_signature ctx p jsig with - | CTPath path -> - let pos = { p with pfile = p.pfile ^ " (" ^ f.jf_name ^" @:throws)" } in - let path = path.path in - EImport( List.map (fun s -> s,pos) (path.tpackage @ [path.tname]), INormal ) - | _ -> die "" __LOC__ - ) f.jf_throws - ) jc.cmethods) in - - if not (show_in_completion ctx jc) then meta := (Meta.NoCompletion,[],null_pos) :: !meta; - - (EClass { - d_name = jname_to_hx (snd jc.cpath),null_pos; - d_doc = None; - d_params = List.map (convert_param ctx p jc.cpath) jc.ctypes; - d_meta = !meta; - d_flags = !flags; - d_data = !fields; - }) :: imports - - let create_ctx com is_std = - { - jcom = com; - jtparams = []; - is_std = is_std; - } - - let rec has_type_param = function - | TTypeParameter _ -> true - | TMethod (lst, opt) -> List.exists has_type_param lst || Option.map_default has_type_param false opt - | TArray (s,_) -> has_type_param s - | TObjectInner (_, stpl) -> List.exists (fun (_,sigs) -> List.exists has_type_param_arg sigs) stpl - | TObject(_, pl) -> List.exists has_type_param_arg pl - | _ -> false - - and has_type_param_arg = function | TType(_,s) -> has_type_param s | _ -> false - -let rec japply_params jparams jsig = match jparams with - | [] -> jsig - | _ -> - match jsig with - | TObject(path,p) -> - TObject(path, List.map (japply_params_tp jparams ) p) - | TObjectInner(sl,stargl) -> - TObjectInner(sl,List.map (fun (s,targ) -> (s, List.map (japply_params_tp jparams) targ)) stargl) - | TArray(jsig,io) -> - TArray(japply_params jparams jsig,io) - | TMethod(args,ret) -> - TMethod(List.map (japply_params jparams ) args, Option.map (japply_params jparams ) ret) - | TTypeParameter s -> (try - List.assoc s jparams - with | Not_found -> jsig) - | _ -> jsig - - -and japply_params_tp jparams jtype_argument = match jtype_argument with - | TAny -> TAny - | TType(w,jsig) -> TType(w,japply_params jparams jsig) - -let mk_jparams jtypes params = match jtypes, params with - | [], [] -> [] - | _, [] -> List.map (fun (s,_,_) -> s, TObject( (["java";"lang"], "Object"), [] ) ) jtypes - | _ -> List.map2 (fun (s,_,_) jt -> match jt with - | TAny -> s, TObject((["java";"lang"],"Object"),[]) - | TType(_,jsig) -> s, jsig) jtypes params - -let rec compatible_signature_arg ?arg_test f1 f2 = - let arg_test = match arg_test with - | None -> (fun _ _ -> true) - | Some a -> a - in - if f1 = f2 then - true - else match f1, f2 with - | TObject(p,a), TObject(p2,a2) -> p = p2 && arg_test a a2 - | TObjectInner(sl, stal), TObjectInner(sl2, stal2) -> sl = sl2 && List.map fst stal = List.map fst stal2 - | TArray(s,_) , TArray(s2,_) -> compatible_signature_arg s s2 - | TTypeParameter t1 , TTypeParameter t2 -> t1 = t2 - | _ -> false - -let rec compatible_param p1 p2 = match p1, p2 with - | TType (_,s1), TType(_,s2) -> compatible_signature_arg ~arg_test:compatible_tparams s1 s2 - | TAny, TType(_, TObject( (["java";"lang"],"Object"), _ )) -> true - | TType(_, TObject( (["java";"lang"],"Object"), _ )), TAny -> true - | _ -> false - -and compatible_tparams p1 p2 = try match p1, p2 with - | [], [] -> true - | _, [] -> - let p2 = List.map (fun _ -> TAny) p1 in - List.for_all2 compatible_param p1 p2 - | [], _ -> - let p1 = List.map (fun _ -> TAny) p2 in - List.for_all2 compatible_param p1 p2 - | _, _ -> - List.for_all2 compatible_param p1 p2 - with | Invalid_argument _ -> false - -let get_adapted_sig f f2 = match f.jf_types with - | [] -> - f.jf_signature - | _ -> - let jparams = mk_jparams f.jf_types (List.map (fun (s,_,_) -> TType(WNone, TTypeParameter s)) f2.jf_types) in - japply_params jparams f.jf_signature - -let compatible_methods f1 f2 = - if List.length f1.jf_types <> List.length f2.jf_types then - false - else match (get_adapted_sig f1 f2), f2.jf_signature with - | TMethod(a1,_), TMethod(a2,_) when List.length a1 = List.length a2 -> - List.for_all2 compatible_signature_arg a1 a2 - | _ -> false - -let jcl_from_jsig com jsig = - let path, params = match jsig with - | TObject(path, params) -> - path,params - | TObjectInner(sl, stll) -> - let last_params = ref [] in - let real_path = sl, String.concat "$" (List.map (fun (s,p) -> last_params := p; s) stll) in - real_path, !last_params - | _ -> raise Not_found - in - match lookup_jclass com path with - | None -> raise Not_found - | Some(c,_,_) -> c,params - -let jclass_with_params com cls params = try - match cls.ctypes with - | [] -> cls - | _ -> - let jparams = mk_jparams cls.ctypes params in - { cls with - cfields = List.map (fun f -> { f with jf_signature = japply_params jparams f.jf_signature }) cls.cfields; - cmethods = List.map (fun f -> { f with jf_signature = japply_params jparams f.jf_signature }) cls.cmethods; - csuper = japply_params jparams cls.csuper; - cinterfaces = List.map (japply_params jparams) cls.cinterfaces; - } - with Invalid_argument _ -> - if com.verbose then print_endline ("Differing parameters for class: " ^ s_type_path cls.cpath); - cls - -let is_object = function | TObject( (["java";"lang"], "Object"), [] ) -> true | _ -> false - -let is_tobject = function | TObject _ | TObjectInner _ -> true | _ -> false - -let simplify_args args = - if List.for_all (function | TAny -> true | _ -> false) args then [] else args - -let compare_type com s1 s2 = - if s1 = s2 then - 0 - else if not (is_tobject s1) then - if is_tobject s2 then (* Dynamic *) - 1 - else if compatible_signature_arg s1 s2 then - 0 - else - raise Exit - else if not (is_tobject s2) then - -1 - else begin - let rec loop ?(first_error=true) s1 s2 : bool = - if is_object s1 then - s1 = s2 - else if compatible_signature_arg s1 s2 then begin - let p1, p2 = match s1, s2 with - | TObject(_, p1), TObject(_,p2) -> - p1, p2 - | TObjectInner(_, npl1), TObjectInner(_, npl2) -> - snd (List.hd (List.rev npl1)), snd (List.hd (List.rev npl2)) - | _ -> die "" __LOC__ (* not tobject *) - in - let p1, p2 = simplify_args p1, simplify_args p2 in - let lp1 = List.length p1 in - let lp2 = List.length p2 in - if lp1 > lp2 then - true - else if lp2 > lp1 then - false - else begin - (* if compatible tparams, it's fine *) - if not (compatible_tparams p1 p2) then - raise Exit; (* meaning: found, but incompatible type parameters *) - true - end - end else try - let c, p = jcl_from_jsig com s1 in - let jparams = mk_jparams c.ctypes p in - let super = japply_params jparams c.csuper in - let implements = List.map (japply_params jparams) c.cinterfaces in - loop ~first_error:first_error super s2 || List.exists (fun super -> loop ~first_error:first_error super s2) implements - with | Not_found -> - print_endline ("--java-lib: The type " ^ (s_sig s1) ^ " is referred but was not found. Compilation may not occur correctly."); - print_endline "Did you forget to include a needed lib?"; - if first_error then - not (loop ~first_error:false s2 s1) - else - false - in - if loop s1 s2 then - if loop s2 s1 then - 0 - else - 1 - else - if loop s2 s1 then - -1 - else - -2 - end - -(* given a list of same overload functions, choose the best (or none) *) -let select_best com flist = - let rec loop cur_best = function - | [] -> - Some cur_best - | f :: flist -> match get_adapted_sig f cur_best, cur_best.jf_signature with - | TMethod(_,Some r), TMethod(_, Some r2) -> (try - match compare_type com r r2 with - | 0 -> (* same type - select any of them *) - loop cur_best flist - | 1 -> - loop f flist - | -1 -> - loop cur_best flist - | -2 -> (* error - no type is compatible *) - if com.verbose then print_endline (f.jf_name ^ ": The types " ^ (s_sig r) ^ " and " ^ (s_sig r2) ^ " are incompatible"); - (* bet that the current best has "beaten" other types *) - loop cur_best flist - | _ -> die "" __LOC__ - with | Exit -> (* incompatible type parameters *) - (* error mode *) - if com.verbose then print_endline (f.jf_name ^ ": Incompatible argument return signatures: " ^ (s_sig r) ^ " and " ^ (s_sig r2)); - None) - | TMethod _, _ -> (* select the method *) - loop f flist - | _ -> - loop cur_best flist - in - match loop (List.hd flist) (List.tl flist) with - | Some f -> - Some f - | None -> match List.filter (fun f -> not (is_override f)) flist with - (* error mode; take off all override methods *) - | [] -> None - | f :: [] -> Some f - | f :: flist -> Some f (* pick one *) - -(**** begin normalize_jclass helpers ****) - -let fix_overrides_jclass com cls = - let force_check = Common.defined com Define.ForceLibCheck in - let methods = if force_check then List.map (fun f -> del_override f) cls.cmethods else cls.cmethods in - let cmethods = methods in - let super_fields = [] in - let super_methods = [] in - let nonstatics = List.filter (fun f -> not (List.mem JStatic f.jf_flags)) (cls.cfields @ cls.cmethods) in - - let is_pub = fun f -> List.exists (function | JPublic | JProtected -> true | _ -> false) f.jf_flags in - let cmethods, super_fields = if not (List.mem JInterface cls.cflags) then - List.filter is_pub cmethods, - List.filter is_pub super_fields - else - cmethods,super_fields - in - - let rec loop cls super_methods super_fields cmethods nonstatics = try - match cls.csuper with - | TObject((["java";"lang"],"Object"),_) -> - super_methods,super_fields,cmethods,nonstatics - | _ -> - let cls, params = jcl_from_jsig com cls.csuper in - let cls = jclass_with_params com cls params in - let nonstatics = (List.filter (fun f -> (List.mem JStatic f.jf_flags)) (cls.cfields @ cls.cmethods)) @ nonstatics in - let super_methods = cls.cmethods @ super_methods in - let super_fields = cls.cfields @ super_fields in - let cmethods = if force_check then begin - let overridden = ref [] in - let cmethods = List.map (fun jm -> - (* TODO rewrite/standardize empty spaces *) - if not (is_override jm) && not (List.mem JStatic jm.jf_flags) && List.exists (fun msup -> - let ret = msup.jf_name = jm.jf_name && not(List.mem JStatic msup.jf_flags) && compatible_methods msup jm in - if ret then begin - let f = mk_override msup in - overridden := { f with jf_flags = jm.jf_flags } :: !overridden - end; - ret - ) cls.cmethods then - mk_override jm - else - jm - ) cmethods in - !overridden @ cmethods - end else - cmethods - in - loop cls super_methods super_fields cmethods nonstatics - with | Not_found -> - super_methods,super_fields,cmethods,nonstatics - in - loop cls super_methods super_fields cmethods nonstatics - -let normalize_jclass com cls = - (* after adding the noCheck metadata, this option will annotate what changes were needed *) - (* and that are now deprecated *) - let force_check = Common.defined com Define.ForceLibCheck in - (* fix overrides *) - let super_methods, super_fields, cmethods, nonstatics = fix_overrides_jclass com cls in - let all_methods = cmethods @ super_methods in - - (* look for interfaces and add missing implementations (may happen on abstracts or by vmsig differences *) - (* (libType): even with libType enabled, we need to add these missing fields - otherwise we won't be able to use them from Haxe *) - let added_interface_fields = ref [] in - let rec loop_interface abstract cls iface = try - match iface with - | TObject ((["java";"lang"],"Object"), _) -> () - | TObject (path,_) when path = cls.cpath -> () - | _ -> - let cif, params = jcl_from_jsig com iface in - let cif = jclass_with_params com cif params in - List.iter (fun jf -> - if not(List.mem JStatic jf.jf_flags) && not (List.exists (fun jf2 -> jf.jf_name = jf2.jf_name && not (List.mem JStatic jf2.jf_flags) && jf.jf_signature = jf2.jf_signature) all_methods) then begin - let jf = if abstract && force_check then del_override jf else jf in - let jf = if not (List.mem JPublic jf.jf_flags) then { jf with jf_flags = JPublic :: jf.jf_flags } else jf in (* interfaces implementations are always public *) - - added_interface_fields := jf :: !added_interface_fields; - end - ) cif.cmethods; - (* we don't need to loop again in the interface unless we are in an abstract class, since these interfaces are already normalized *) - if abstract then List.iter (loop_interface abstract cif) cif.cinterfaces; - with Not_found -> () - in - List.iter (loop_interface (List.mem JAbstract cls.cflags) cls) cls.cinterfaces; - let nonstatics = !added_interface_fields @ nonstatics in - let cmethods = !added_interface_fields @ cmethods in - - (* for each added field in the interface, lookup in super_methods possible methods to include *) - (* so we can choose the better method still *) - let cmethods = if not force_check then - cmethods - else - List.fold_left (fun cmethods im -> - (* see if any of the added_interface_fields need to be declared as override *) - let f = List.find_all (fun jf -> jf.jf_name = im.jf_name && compatible_methods jf im) super_methods in - let f = List.map mk_override f in - f @ cmethods - ) cmethods !added_interface_fields; - in - - (* take off equals, hashCode and toString from interface *) - let cmethods = if List.mem JInterface cls.cflags then List.filter (fun jf -> match jf.jf_name, jf.jf_vmsignature with - | "equals", TMethod([TObject( (["java";"lang"],"Object"), _)],_) - | "hashCode", TMethod([], _) - | "toString", TMethod([], _) -> false - | _ -> true - ) cmethods - else - cmethods - in - - (* change field name to not collide with haxe keywords and with static/non-static members *) - let fold_field acc f = - let change, both = match f.jf_name with - | _ when List.mem JStatic f.jf_flags && List.exists (fun f2 -> f.jf_name = f2.jf_name) nonstatics -> true, true - | _ -> is_haxe_keyword f.jf_name, false - in - let f2 = if change then - { f with jf_name = "%" ^ f.jf_name } - else - f - in - if both then f :: f2 :: acc else f2 :: acc - in - - (* change static fields that have the same name as methods *) - let cfields = List.fold_left fold_field [] cls.cfields in - let cmethods = List.fold_left fold_field [] cmethods in - (* take off variable fields that have the same name as methods *) - (* and take off variables that already have been declared *) - let filter_field f f2 = f != f2 && (List.mem JStatic f.jf_flags = List.mem JStatic f2.jf_flags) && f.jf_name = f2.jf_name && f2.jf_kind <> f.jf_kind in - let cfields = List.filter (fun f -> - if List.mem JStatic f.jf_flags then - not (List.exists (filter_field f) cmethods) - else - not (List.exists (filter_field f) nonstatics) && not (List.exists (fun f2 -> f != f2 && f.jf_name = f2.jf_name && not (List.mem JStatic f2.jf_flags)) super_fields) ) cfields - in - (* now filter any method that clashes with a field - on a superclass *) - let cmethods = if force_check then List.filter (fun f -> - if List.mem JStatic f.jf_flags then - true - else - not (List.exists (filter_field f) super_fields) ) cmethods - else - cmethods - in - (* removing duplicate fields. They are there because of return type covariance in Java *) - (* Also, if a method overrides a previous definition, and changes a type parameters' variance, *) - (* we will take it off *) - (* this means that some rare codes will never compile on Haxe, but unless Haxe adds variance support *) - (* I can't see how this can be any different *) - let rec loop acc = function - | [] -> acc - | f :: cmeths -> - match List.partition (fun f2 -> f.jf_name = f2.jf_name && compatible_methods f f2) cmeths with - | [], cmeths -> - loop (f :: acc) cmeths - | flist, cmeths -> match select_best com (f :: flist) with - | None -> - loop acc cmeths - | Some f -> - loop (f :: acc) cmeths - in - (* last pass: take off all cfields that are internal / private (they won't be accessible anyway) *) - let cfields = List.filter(fun f -> List.exists (fun f -> f = JPublic || f = JProtected) f.jf_flags) cfields in - let cmethods = loop [] cmethods in - { cls with cfields = cfields; cmethods = cmethods } - -(**** end normalize_jclass helpers ****) - -let get_classes_zip zip = - let ret = ref [] in - List.iter (function - | { Zip.is_directory = false; Zip.filename = f } when (String.sub (String.uncapitalize f) (String.length f - 6) 6) = ".class" && not (String.exists f "$") -> - (match List.rev (String.nsplit f "/") with - | clsname :: pack -> - if not (String.contains clsname '$') then begin - let path = jpath_to_hx (List.rev pack, String.sub clsname 0 (String.length clsname - 6)) in - ret := path :: !ret - end - | _ -> - ret := ([], jname_to_hx f) :: !ret) - | _ -> () - ) (Zip.entries zip); - !ret - -class virtual java_library com name file_path = object(self) - inherit [java_lib_type,unit] native_library name file_path as super - - val hxpack_to_jpack = Hashtbl.create 16 - - method convert_path (path : path) : path = - Hashtbl.find hxpack_to_jpack path - - method private replace_canonical_name p pack name_original name_replace decl = - let mk_meta name = (Meta.JavaCanonical, [EConst (String (String.concat "." pack,SDoubleQuotes)), p; EConst(String (name,SDoubleQuotes)), p], p) in - let add_meta name metas = - if Meta.has Meta.JavaCanonical metas then - List.map (function - | (Meta.JavaCanonical,[EConst (String(cpack,_)), _; EConst(String(cname,_)), _],_) -> - let did_replace,name = String.replace cname name_original name_replace in - if not did_replace then print_endline (cname ^ " -> " ^ name_original ^ " -> " ^ name_replace); - mk_meta name - | m -> m - ) metas - else - mk_meta name :: metas - in - match decl with - | EClass c -> - EClass { c with d_meta = add_meta (fst c.d_name) c.d_meta } - | EEnum e -> - EEnum { e with d_meta = add_meta (fst e.d_name) e.d_meta } - | EAbstract a -> - EAbstract { a with d_meta = add_meta (fst a.d_name) a.d_meta } - | d -> d - - method build path (p : pos) : Ast.package option = - let rec build ctx path p types = - try - if List.mem path !types then - None - else begin - let first = match !types with - | [ ["java";"lang"], "String" ] | [] -> true - | p :: _ -> - false - in - types := path :: !types; - match self#lookup path, path with - | None, ([], c) -> build ctx (["haxe";"root"], c) p types - | None, _ -> None - | Some (cls, real_path, pos_path), _ -> - let is_disallowed_inner = first && String.exists (snd cls.cpath) "$" in - let is_disallowed_inner = if is_disallowed_inner then begin - let outer, inner = String.split (snd cls.cpath) "$" in - match self#lookup (fst path, outer) with - | None -> false - | _ -> true - end else - false - in - if is_disallowed_inner then - None - else begin - if ctx.jcom.verbose then print_endline ("Parsed Java class " ^ (s_type_path cls.cpath)); - let old_types = ctx.jtparams in - ctx.jtparams <- cls.ctypes :: ctx.jtparams; - - let pos = { pfile = pos_path; pmin = 0; pmax = 0; } in - - let pack = match fst path with | ["haxe";"root"] -> [] | p -> p in - - let ppath = self#convert_path path in - let inner = List.fold_left (fun acc (path,out,_,_) -> - let path = jpath_to_hx path in - (if out <> Some ppath then - acc - else match build ctx path p types with - | Some(_, classes) -> - let base = snd ppath ^ "$" in - (List.map (fun (def,p) -> - self#replace_canonical_name p (fst ppath) base (snd ppath ^ ".") def, p) classes) @ acc - | _ -> acc); - ) [] cls.cinner_types in - - (* add _Statics class *) - let inner = try - if not (List.mem JInterface cls.cflags) then raise Not_found; - let smethods = List.filter (fun f -> List.mem JStatic f.jf_flags) cls.cmethods in - let sfields = List.filter (fun f -> List.mem JStatic f.jf_flags) cls.cfields in - if not (smethods <> [] || sfields <> []) then raise Not_found; - let obj = TObject( (["java";"lang"],"Object"), []) in - let ncls = convert_java_class ctx pos { cls with cmethods = smethods; cfields = sfields; cflags = []; csuper = obj; cinterfaces = []; cinner_types = []; ctypes = [] } in - match ncls with - | EClass c :: imports -> - (EClass { c with d_name = (fst c.d_name ^ "_Statics"),snd c.d_name }, pos) :: inner @ List.map (fun i -> i,pos) imports - | _ -> die "" __LOC__ - with | Not_found -> - inner - in - let inner_alias = ref SS.empty in - List.iter (fun x -> - match fst x with - | EClass c -> - inner_alias := SS.add (fst c.d_name) !inner_alias; - | _ -> () - ) inner; - let alias_list = ref [] in - List.iter (fun x -> - match x with - | (EClass c, pos) -> begin - let parts = String.nsplit (fst c.d_name) "_24" in - match parts with - | _ :: _ -> - let alias_name = String.concat "_" parts in - if (not (SS.mem alias_name !inner_alias)) && (not (String.exists (snd path) "_24")) then begin - let alias_def = ETypedef { - d_name = alias_name,null_pos; - d_doc = None; - d_params = c.d_params; - d_meta = []; - d_flags = []; - d_data = make_ptp_th_null { - tpackage = pack; - tname = snd path; - tparams = List.map (fun tp -> - TPType (make_ptp_th_null { - tpackage = []; - tname = fst tp.tp_name; - tparams = []; - tsub = None; - }) - ) c.d_params; - tsub = Some(fst c.d_name); - }; - } in - inner_alias := SS.add alias_name !inner_alias; - alias_list := (alias_def, pos) :: !alias_list; - end - | _ -> () - end - | _ -> () - ) inner; - let inner = List.concat [!alias_list ; inner] in - let classes = List.map (fun t -> t,pos) (convert_java_class ctx pos cls) in - let imports, defs = List.partition (function | (EImport(_),_) -> true | _ -> false) (classes @ inner) in - let ret = Some (pack, imports @ defs) in - ctx.jtparams <- old_types; - ret - end - end - with - | JReader.Error_message msg -> - print_endline ("Class reader failed: " ^ msg); - None - | e -> - if ctx.jcom.verbose then begin - (* print_endline (Printexc.get_backtrace ()); requires ocaml 3.11 *) - print_endline (Printexc.to_string e) - end; - None - in - build (create_ctx com (self#has_flag FlagIsStd)) path p (ref [["java";"lang"], "String"]) - - method get_data = () -end - -class java_library_jar com name file_path = object(self) - inherit java_library com name file_path - - val zip = lazy (Zip.open_in file_path) - val mutable cached_files = None - val cached_types = Hashtbl.create 12 - val mutable loaded = false - val mutable closed = false - - method load = - if not loaded then begin - loaded <- true; - List.iter (function - | { Zip.is_directory = false; Zip.filename = filename } when String.ends_with filename ".class" -> - let pack = String.nsplit filename "/" in - (match List.rev pack with - | [] -> () - | name :: pack -> - let name = String.sub name 0 (String.length name - 6) in - let pack = List.rev pack in - Hashtbl.add hxpack_to_jpack (jpath_to_hx (pack,name)) (pack,name)) - | _ -> () - ) (Zip.entries (Lazy.force zip)) - end - - method private lookup' ((pack,name) : path) : java_lib_type = - try - let zip = Lazy.force zip in - let location = (String.concat "/" (pack @ [name]) ^ ".class") in - let entry = Zip.find_entry zip location in - let data = Zip.read_entry zip entry in - Some(JReader.parse_class (IO.input_string data), file_path, file_path ^ "@" ^ location) - with - | Not_found -> - None - - method lookup (path : path) : java_lib_type = - try - Hashtbl.find cached_types path - with | Not_found -> try - self#load; - let pack, name = self#convert_path path in - let try_file (pack,name) = - match self#lookup' (pack,name) with - | None -> - Hashtbl.add cached_types path None; - None - | Some (i, p1, p2) -> - Hashtbl.add cached_types path (Some(i,p1,p2)); (* type loop normalization *) - let ret = Some (normalize_jclass com i, p1, p2) in - Hashtbl.replace cached_types path ret; - ret - in - try_file (pack,name) - with Not_found -> - None - - method close = - if not closed then begin - closed <- true; - Zip.close_in (Lazy.force zip) - end - - method private list_modules' : path list = - let ret = ref [] in - List.iter (function - | { Zip.is_directory = false; Zip.filename = f } when (String.sub (String.uncapitalize f) (String.length f - 6) 6) = ".class" && not (String.exists f "$") -> - (match List.rev (String.nsplit f "/") with - | clsname :: pack -> - if not (String.contains clsname '$') then begin - let path = jpath_to_hx (List.rev pack, String.sub clsname 0 (String.length clsname - 6)) in - ret := path :: !ret - end - | _ -> - ret := ([], jname_to_hx f) :: !ret) - | _ -> () - ) (Zip.entries (Lazy.force zip)); - !ret - - method list_modules : path list = match cached_files with - | None -> - let ret = self#list_modules' in - cached_files <- Some ret; - ret - | Some r -> - r -end - -class java_library_dir com name file_path = object(self) - inherit java_library com name file_path - - val mutable files = [] - - method load = - let all = ref [] in - let rec iter_files pack dir path = try - let file = Unix.readdir dir in - let filepath = path ^ "/" ^ file in - (if String.ends_with file ".class" then - let name = String.sub file 0 (String.length file - 6) in - let path = jpath_to_hx (pack,name) in - if not (String.exists file "$") then all := path :: !all; - Hashtbl.add hxpack_to_jpack path (pack,name) - else if (Unix.stat filepath).st_kind = S_DIR && file <> "." && file <> ".." then - let pack = pack @ [file] in - iter_files (pack) (Unix.opendir filepath) filepath); - iter_files pack dir path - with | End_of_file | Unix.Unix_error _ -> - Unix.closedir dir - in - iter_files [] (Unix.opendir file_path) file_path; - files <- !all - - method close = - () - - method list_modules = - files - - method lookup (pack,name) : java_lib_type = - let real_path = file_path ^ "/" ^ (String.concat "/" pack) ^ "/" ^ (name ^ ".class") in - try - let data = Std.input_file ~bin:true real_path in - Some(JReader.parse_class (IO.input_string data), real_path, real_path) - with - | _ -> None -end - -let add_java_lib com name std extern modern = - let file = if Sys.file_exists name then - name - else try Common.find_file com name with - | Not_found -> try Common.find_file com (name ^ ".jar") with - | Not_found -> - failwith ("Java lib " ^ name ^ " not found") - in - let java_lib = - if modern then - (new JavaModern.java_library_modern com name file :> (java_lib_type,unit) native_library) - else match (Unix.stat file).st_kind with - | S_DIR -> - (new java_library_dir com name file :> (java_lib_type,unit) native_library) - | _ -> - (new java_library_jar com name file :> (java_lib_type,unit) native_library) - in - if std then java_lib#add_flag FlagIsStd; - if extern then java_lib#add_flag FlagIsExtern; - com.native_libs.java_libs <- (java_lib :> (java_lib_type,unit) native_library) :: com.native_libs.java_libs; - CommonCache.handle_native_lib com java_lib - -let before_generate con = - let java_ver = try - int_of_string (Common.defined_value con Define.JavaVer) - with | Not_found -> - Common.define_value con Define.JavaVer "7"; - 7 - in - if java_ver < 5 then failwith ("Java version is defined to target Java " ^ string_of_int java_ver ^ ", but the compiler can only output code to versions equal or superior to Java 5"); - let rec loop i = - Common.raw_define con ("java" ^ (string_of_int i)); - if i > 0 then loop (i - 1) - in - loop java_ver diff --git a/src/codegen/javaModern.ml b/src/codegen/javaModern.ml index 8eb631128d9..53de05e2da1 100644 --- a/src/codegen/javaModern.ml +++ b/src/codegen/javaModern.ml @@ -1093,3 +1093,19 @@ class java_library_modern com name file_path = object(self) method get_data = () end + +let add_java_lib com name std extern = + let file = if Sys.file_exists name then + name + else try Common.find_file com name with + | Not_found -> try Common.find_file com (name ^ ".jar") with + | Not_found -> + failwith ("Java lib " ^ name ^ " not found") + in + let java_lib = + (new java_library_modern com name file :> (java_lib_type,unit) native_library) + in + if std then java_lib#add_flag FlagIsStd; + if extern then java_lib#add_flag FlagIsExtern; + com.native_libs.java_libs <- (java_lib :> (java_lib_type,unit) native_library) :: com.native_libs.java_libs; + CommonCache.handle_native_lib com java_lib \ No newline at end of file diff --git a/src/compiler/args.ml b/src/compiler/args.ml index 45edbf9008f..127d84f9e6c 100644 --- a/src/compiler/args.ml +++ b/src/compiler/args.ml @@ -88,16 +88,9 @@ let parse_args com = Common.define com Define.Cppia; set_platform com Cpp file; ),"","generate Cppia bytecode into target file"); - ("Target",["--cs"],["-cs"],Arg.String (fun dir -> - set_platform com Cs dir; - ),"","generate C# code into target directory"); - ("Target",["--java"],["-java"],Arg.String (fun dir -> - set_platform com Java dir; - ),"","generate Java code into target directory"); - ("Target",["--jvm"],[],Arg.String (fun dir -> - Common.define com Define.Jvm; + ("Target",["--jvm"],["-jvm"],Arg.String (fun dir -> actx.jvm_flag <- true; - set_platform com Java dir; + set_platform com Jvm dir; ),"","generate JVM bytecode into target file"); ("Target",["--python"],["-python"],Arg.String (fun dir -> set_platform com Python dir; @@ -232,15 +225,6 @@ let parse_args com = ("Target-specific",["--java-lib-extern"],[],Arg.String (fun file -> add_native_lib file true JavaLib; ),"","use an external JAR or directory of JAR files for type checking"); - ("Target-specific",["--net-lib"],["-net-lib"],Arg.String (fun file -> - add_native_lib file false NetLib; - ),"[@std]","add an external .NET DLL file"); - ("Target-specific",["--net-std"],["-net-std"],Arg.String (fun file -> - Dotnet.add_net_std com file - ),"","add a root std .NET DLL search path"); - ("Target-specific",["--c-arg"],["-c-arg"],Arg.String (fun arg -> - com.c_args <- arg :: com.c_args - ),"","pass option to the native Java/C# compiler"); ("Compilation",["-r";"--resource"],["-resource"],Arg.String (fun res -> let file, name = (match ExtString.String.nsplit res "@" with | [file; name] -> file, name @@ -381,7 +365,6 @@ let parse_args com = if not (lib#has_flag NativeLibraries.FlagIsStd) then List.iter (fun path -> if path <> (["java";"lang"],"String") then actx.classes <- path :: actx.classes) lib#list_modules in - List.iter process_lib com.native_libs.net_libs; List.iter process_lib com.native_libs.swf_libs; List.iter process_lib com.native_libs.java_libs; ) :: actx.pre_compilation; diff --git a/src/compiler/compilationContext.ml b/src/compiler/compilationContext.ml index f6697e4e136..5f1f91489dd 100644 --- a/src/compiler/compilationContext.ml +++ b/src/compiler/compilationContext.ml @@ -8,7 +8,6 @@ type server_mode = | SMConnect of string type native_lib_kind = - | NetLib | JavaLib | SwfLib | HxbLib diff --git a/src/compiler/compiler.ml b/src/compiler/compiler.ml index 93ee2464f6b..52fef29aed9 100644 --- a/src/compiler/compiler.ml +++ b/src/compiler/compiler.ml @@ -138,15 +138,9 @@ module Setup = struct if Common.defined com Define.Cppia then actx.classes <- (Path.parse_path "cpp.cppia.HostClasses" ) :: actx.classes; "cpp" - | Cs -> - Dotnet.before_generate com; - add_std "cs"; "cs" - | Java -> - Java.before_generate com; - if defined com Define.Jvm then begin - add_std "jvm"; - com.package_rules <- PMap.remove "jvm" com.package_rules; - end; + | Jvm -> + add_std "jvm"; + com.package_rules <- PMap.remove "java" com.package_rules; add_std "java"; "java" | Python -> @@ -467,7 +461,6 @@ let finalize ctx = we should do it here to be safe. *) if not ctx.comm.is_server then begin List.iter (fun lib -> lib#close) ctx.com.native_libs.java_libs; - List.iter (fun lib -> lib#close) ctx.com.native_libs.net_libs; List.iter (fun lib -> lib#close) ctx.com.native_libs.swf_libs; end @@ -633,10 +626,8 @@ module HighLevel = struct List.iter (fun l -> Hashtbl.add added_libs l ()) libs; let lines = add_libs libs args server_api.cache has_display in loop acc (lines @ args) - | ("--jvm" | "--java" | "-java" as arg) :: dir :: args -> + | ("--jvm" | "-jvm" as arg) :: dir :: args -> loop_lib arg dir "hxjava" acc args - | ("--cs" | "-cs" as arg) :: dir :: args -> - loop_lib arg dir "hxcs" acc args | arg :: l -> match List.rev (ExtString.String.nsplit arg ".") with | "hxml" :: _ :: _ when (match acc with "-cmd" :: _ | "--cmd" :: _ -> false | _ -> true) -> diff --git a/src/compiler/generate.ml b/src/compiler/generate.ml index 04718ece5e0..81216293a49 100644 --- a/src/compiler/generate.ml +++ b/src/compiler/generate.ml @@ -126,8 +126,7 @@ let generate ctx tctx ext actx = begin match com.platform with | Neko | Hl | Eval when actx.interp -> () | Cpp when Common.defined com Define.Cppia -> () - | Cpp | Cs | Php -> Path.mkdir_from_path (com.file ^ "/.") - | Java when not actx.jvm_flag -> Path.mkdir_from_path (com.file ^ "/.") + | Cpp | Php -> Path.mkdir_from_path (com.file ^ "/.") | _ -> Path.mkdir_from_path com.file end; if actx.interp then begin @@ -158,13 +157,8 @@ let generate ctx tctx ext actx = Genphp7.generate,"php" | Cpp -> Gencpp.generate,"cpp" - | Cs -> - Gencs.generate,"cs" - | Java -> - if Common.defined com Jvm then - Genjvm.generate actx.jvm_flag,"java" - else - Genjava.generate,"java" + | Jvm -> + Genjvm.generate actx.jvm_flag,"jvm" | Python -> Genpy.generate,"python" | Hl -> diff --git a/src/context/common.ml b/src/context/common.ml index 37dae49f490..ffcb5f91d06 100644 --- a/src/context/common.ml +++ b/src/context/common.ml @@ -415,7 +415,6 @@ type context = { 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; mutable js_gen : (unit -> unit) option; (* misc *) mutable basic : basic_types; @@ -476,7 +475,7 @@ let external_defined_value ctx k = Define.raw_defined_value ctx.defines (convert_define k) let reserved_flags = [ - "true";"false";"null";"cross";"js";"lua";"neko";"flash";"php";"cpp";"cs";"java";"python";"hl";"hlc"; + "true";"false";"null";"cross";"js";"lua";"neko";"flash";"php";"cpp";"java";"jvm";"python";"hl";"hlc"; "swc";"macro";"sys";"static";"utf16";"haxe";"haxe_ver" ] @@ -523,8 +522,7 @@ let short_platform_name = function | Flash -> "swf" | Php -> "php" | Cpp -> "cpp" - | Cs -> "cs" - | Java -> "jav" + | Jvm -> "jvm" | Python -> "py" | Hl -> "hl" | Eval -> "evl" @@ -686,35 +684,7 @@ let get_config com = }; pf_supports_atomics = true; } - | Cs -> - { - default_config with - pf_capture_policy = CPWrapRef; - pf_pad_nulls = true; - pf_overload = true; - pf_supports_threads = true; - pf_supports_rest_args = true; - pf_this_before_super = false; - pf_exceptions = { default_config.pf_exceptions with - ec_native_throws = [ - ["cs";"system"],"Exception"; - ["haxe"],"Exception"; - ]; - ec_native_catches = [ - ["cs";"system"],"Exception"; - ["haxe"],"Exception"; - ]; - ec_wildcard_catch = (["cs";"system"],"Exception"); - ec_base_throw = (["cs";"system"],"Exception"); - ec_special_throw = fun e -> e.eexpr = TIdent "__rethrow__" - }; - pf_scoping = { - vs_scope = FunctionScope; - vs_flags = [NoShadowing] - }; - pf_supports_atomics = true; - } - | Java -> + | Jvm -> { default_config with pf_capture_policy = CPWrapRef; @@ -735,14 +705,6 @@ let get_config com = ec_wildcard_catch = (["java";"lang"],"Throwable"); ec_base_throw = (["java";"lang"],"RuntimeException"); }; - pf_scoping = - if defined Jvm then - default_config.pf_scoping - else - { - vs_scope = FunctionScope; - vs_flags = [NoShadowing; ReserveAllTopLevelSymbols; ReserveNames(["_"])]; - }; pf_supports_atomics = true; } | Python -> @@ -841,7 +803,6 @@ let create compilation_step cs version args display_mode = native_libs = create_native_libs(); hxb_libs = []; net_path_map = Hashtbl.create 0; - c_args = []; neko_lib_paths = []; include_files = []; js_gen = None; @@ -979,13 +940,21 @@ let update_platform_config com = let init_platform com = let name = platform_name com.platform in - if (com.platform = Flash) && Path.file_extension com.file = "swc" then define com Define.Swc - else if (com.platform = Hl) && Path.file_extension com.file = "c" then define com Define.Hlc; + begin match com.platform with + | Flash when Path.file_extension com.file = "swc" -> + define com Define.Swc + | Jvm -> + raw_define com "java" + | Hl -> + if Path.file_extension com.file = "c" then define com Define.Hlc; + | _ -> + () + end; (* Set the source header, unless the user has set one already or the platform sets a custom one *) if not (defined com Define.SourceHeader) && (com.platform <> Hl) then define_value com Define.SourceHeader ("Generated by Haxe " ^ s_version_full); let forbid acc p = if p = name || PMap.mem p acc then acc else PMap.add p Forbidden acc in - com.package_rules <- List.fold_left forbid com.package_rules ("jvm" :: (List.map platform_name platforms)); + com.package_rules <- List.fold_left forbid com.package_rules ("java" :: (List.map platform_name platforms)); update_platform_config com; if com.config.pf_static then begin raw_define com "target.static"; @@ -1211,7 +1180,7 @@ let dump_path com = Define.defined_value_safe ~default:"dump" com.defines Define.DumpPath let adapt_defines_to_macro_context defines = - let to_remove = List.map Globals.platform_name Globals.platforms in + let to_remove = "java" :: List.map Globals.platform_name Globals.platforms in let to_remove = List.fold_left (fun acc d -> Define.get_define_key d :: acc) to_remove [Define.NoTraces] in let to_remove = List.fold_left (fun acc (_, d) -> ("flash" ^ d) :: acc) to_remove flash_versions in let macro_defines = { diff --git a/src/context/display/displayPath.ml b/src/context/display/displayPath.ml index 87940cfa93a..27c2cf784d9 100644 --- a/src/context/display/displayPath.ml +++ b/src/context/display/displayPath.ml @@ -74,7 +74,6 @@ module TypePathHandler = struct ) lib#list_modules; in List.iter process_lib com.native_libs.swf_libs; - List.iter process_lib com.native_libs.net_libs; List.iter process_lib com.native_libs.java_libs; unique !packages, unique !classes diff --git a/src/context/nativeLibraries.ml b/src/context/nativeLibraries.ml index 0ee95517450..fe7de4b6396 100644 --- a/src/context/nativeLibraries.ml +++ b/src/context/nativeLibraries.ml @@ -40,20 +40,17 @@ class virtual ['a,'data] native_library (name : string) (file_path : string) = o method virtual get_data : 'data end -type java_lib_type = (JData.jclass * string * string) option -type net_lib_type = IlData.ilclass option +type java_lib_type = (JClass.jclass * string * string) option type swf_lib_type = As3hl.hl_class option type native_libraries = { mutable java_libs : (java_lib_type,unit) native_library list; - mutable net_libs : (net_lib_type,unit) native_library list; mutable swf_libs : (swf_lib_type,Swf.swf) native_library list; mutable all_libs : string list; } let create_native_libs () = { java_libs = []; - net_libs = []; swf_libs = []; all_libs = []; } diff --git a/src/context/nativeLibraryHandler.ml b/src/context/nativeLibraryHandler.ml index 88c42cc8e63..6df94670e2a 100644 --- a/src/context/nativeLibraryHandler.ml +++ b/src/context/nativeLibraryHandler.ml @@ -27,10 +27,9 @@ let add_native_lib com lib = | SwfLib -> SwfLoader.add_swf_lib com file is_extern | JavaLib -> - let use_modern = Common.defined com Define.Jvm && not (Common.defined com Define.JarLegacyLoader) in let add file = let std = file = "lib/hxjava-std.jar" in - Java.add_java_lib com file std is_extern use_modern + JavaModern.add_java_lib com file std is_extern in if try Sys.is_directory file with Sys_error _ -> false then let dir = file in @@ -39,18 +38,9 @@ let add_native_lib com lib = ) (Sys.readdir file)) else add file - | NetLib -> - let file, is_std = match ExtString.String.nsplit file "@" with - | [file] -> - file,false - | [file;"std"] -> - file,true - | _ -> 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/core/globals.ml b/src/core/globals.ml index a7574572d0a..c7a557298c7 100644 --- a/src/core/globals.ml +++ b/src/core/globals.ml @@ -18,8 +18,7 @@ type platform = | Flash | Php | Cpp - | Cs - | Java + | Jvm | Python | Hl | Eval @@ -79,8 +78,7 @@ let platforms = [ Flash; Php; Cpp; - Cs; - Java; + Jvm; Python; Hl; Eval; @@ -95,8 +93,7 @@ let platform_name = function | Flash -> "flash" | Php -> "php" | Cpp -> "cpp" - | Cs -> "cs" - | Java -> "java" + | Jvm -> "jvm" | Python -> "python" | Hl -> "hl" | Eval -> "eval" @@ -110,8 +107,7 @@ let parse_platform = function | "flash" -> Flash | "php" -> Php | "cpp" -> Cpp - | "cs" -> Cs - | "java" -> Java + | "jvm" -> Jvm | "python" -> Python | "hl" -> Hl | "eval" -> Eval diff --git a/src/dune b/src/dune index 311908ad0d9..bc6821e2680 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 ziplib + extc extproc extlib_leftovers 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/capturedVars.ml b/src/filters/capturedVars.ml index d94ac205c28..b5bf1f81c3f 100644 --- a/src/filters/capturedVars.ml +++ b/src/filters/capturedVars.ml @@ -43,11 +43,11 @@ let captured_vars com e = let t = com.basic in let impl = match com.platform with - (* optimized version for C#/Java - use native arrays *) - | Cs | Java -> + (* optimized version for Java - use native arrays *) + | Jvm -> let cnativearray = match (List.find (fun md -> match md with - | TClassDecl ({ cl_path = ["cs"|"java"],"NativeArray" }) -> true + | TClassDecl ({ cl_path = ["java"],"NativeArray" }) -> true | _ -> false ) com.types) with TClassDecl cl -> cl | _ -> die "" __LOC__ @@ -128,11 +128,6 @@ let captured_vars com e = let tmp_used = ref used in let rec browse = function | Block f | Loop f | Function f -> f browse - | Use ({ v_extra = Some({v_params = _ :: _}) }) - | Assign ({ v_extra = Some({v_params = _ :: _}) }) when com.platform = Cs || (com.platform = Java && not (Common.defined com Define.Jvm)) -> - (* Java and C# deal with functions with type parameters in a different way *) - (* so they do should not be wrapped *) - () | Use v | Assign v -> if PMap.mem v.v_id !tmp_used then fused := PMap.add v.v_id v !fused; | Declare v -> @@ -219,10 +214,6 @@ let captured_vars com e = incr depth; f (collect_vars false); decr depth; - | Use ({ v_extra = Some({v_params = _ :: _}) }) - | Assign ({ v_extra = Some({v_params = _ :: _}) }) when com.platform = Cs || (com.platform = Java && not (Common.defined com Define.Jvm)) -> - (* Java/C# use a special handling for functions with type parmaters *) - () | Declare v -> if in_loop then vars := PMap.add v.v_id !depth !vars; | Use v | Assign v -> @@ -256,9 +247,6 @@ let captured_vars com e = decr depth; | Declare v -> vars := PMap.add v.v_id !depth !vars; - | Use ({ v_extra = Some({v_params = _ :: _}) }) - | Assign ({ v_extra = Some({v_params = _ :: _}) }) when com.platform = Cs || (com.platform = Java && not (Common.defined com Define.Jvm)) -> - () | Use v -> (try let d = PMap.find v.v_id !vars in diff --git a/src/filters/exceptions.ml b/src/filters/exceptions.ml index e66758e088c..045b449ef50 100644 --- a/src/filters/exceptions.ml +++ b/src/filters/exceptions.ml @@ -499,7 +499,7 @@ let catch_native ctx catches t p = let filter tctx = let stub e = e in match tctx.com.platform with (* TODO: implement for all targets *) - | Php | Js | Java | Cs | Python | Lua | Eval | Neko | Flash | Hl | Cpp -> + | Php | Js | Jvm | Python | Lua | Eval | Neko | Flash | Hl | Cpp -> let config = tctx.com.config.pf_exceptions in let tp (pack,name) = let tp = match List.rev pack with diff --git a/src/filters/filters.ml b/src/filters/filters.ml index e2d12215832..d9a1077fe60 100644 --- a/src/filters/filters.ml +++ b/src/filters/filters.ml @@ -251,16 +251,6 @@ let mark_switch_break_loops e = in run e -let check_unification ctx e t = - begin match e.eexpr,t with - | TLocal v,TType({t_path = ["cs"],("Ref" | "Out")},_) -> - (* TODO: this smells of hack, but we have to deal with it somehow *) - add_var_flag v VCaptured; - | _ -> - () - end; - e - let rec fix_return_dynamic_from_void_function return_is_void e = match e.eexpr with | TFunction fn -> @@ -352,7 +342,7 @@ let add_meta_field com t = match t with let cf = mk_field ~static:true "__meta__" e.etype e.epos null_pos in cf.cf_expr <- Some e; let can_deal_with_interface_metadata () = match com.platform with - | Cs | Java -> false + | Jvm -> false | _ -> true in if (has_class_flag c CInterface) && not (can_deal_with_interface_metadata()) then begin @@ -370,55 +360,6 @@ let add_meta_field com t = match t with | _ -> () -(* - C# events have special semantics: - if we have an @:event var field, there should also be add_ and remove_ methods, - this filter checks for their existence and also adds some metadata for analyzer and C# generator -*) -let check_cs_events com t = match t with - | TClassDecl cl when not (has_class_flag cl CExtern) -> - let check fields f = - match f.cf_kind with - | Var { v_read = AccNormal; v_write = AccNormal } when Meta.has Meta.Event f.cf_meta && not (has_class_field_flag f CfPostProcessed) -> - if (has_class_field_flag f CfPublic) then raise_typing_error "@:event fields must be private" f.cf_pos; - - (* prevent generating reflect helpers for the event in gencommon *) - f.cf_meta <- (Meta.SkipReflection, [], f.cf_pos) :: f.cf_meta; - - (* type for both add and remove methods *) - let tmeth = (tfun [f.cf_type] com.basic.tvoid) in - - let process_event_method name = - let m = try PMap.find name fields with Not_found -> raise_typing_error ("Missing event method: " ^ name) f.cf_pos in - - (* check method signature *) - begin - try - type_eq EqStrict m.cf_type tmeth - with Unify_error el -> - List.iter (fun e -> com.error (unify_error_msg (print_context()) e) m.cf_pos) el - end; - - (* - add @:pure(false) to prevent purity inference, because empty add/remove methods - have special meaning here and they are always impure - *) - m.cf_meta <- (Meta.Pure,[EConst(Ident "false"),f.cf_pos],f.cf_pos) :: (Meta.Custom ":cs_event_impl",[],f.cf_pos) :: m.cf_meta; - - (* add @:keep to event methods if the event is kept *) - if Meta.has Meta.Keep f.cf_meta && not (Meta.has Meta.Keep m.cf_meta) then - m.cf_meta <- (Dce.mk_keep_meta f.cf_pos) :: m.cf_meta; - in - process_event_method ("add_" ^ f.cf_name); - process_event_method ("remove_" ^ f.cf_name) - | _ -> - () - in - List.iter (check cl.cl_fields) cl.cl_ordered_fields; - List.iter (check cl.cl_statics) cl.cl_ordered_statics - | _ -> - () - (* Removes interfaces tagged with @:remove metadata *) let check_remove_metadata t = match t with | TClassDecl c -> @@ -545,17 +486,13 @@ 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.c.curclass.cl_path locals com mt)); + (match com.platform with | Jvm -> (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 _ -> ())); commit_features com; (if com.config.pf_reserved_type_paths <> [] then check_reserved_type_paths com else (fun _ -> ())); ] in - let type_filters = match com.platform with - | Cs -> type_filters @ [ fun t -> InterfaceProps.run t ] - | _ -> type_filters - in with_timer detail_times "type 3" None (fun () -> List.iter (fun t -> begin match t with @@ -772,26 +709,11 @@ let run tctx main before_destruction = "Exceptions_filter",Exceptions.filter tctx; "captured_vars",CapturedVars.captured_vars com; ] in - let filters = - match com.platform with - | Cs -> - SetHXGen.run_filter com new_types; - filters - | Java when not (Common.defined com Jvm)-> - SetHXGen.run_filter com new_types; - filters - | _ -> filters - in List.iter (run_expression_filters tctx detail_times filters) new_types; (* PASS 1.5: pre-analyzer type filters *) let filters = match com.platform with - | Cs -> - [ - check_cs_events com; - DefaultArguments.run com; - ] - | Java -> + | Jvm -> [ DefaultArguments.run com; ] @@ -810,7 +732,7 @@ let run tctx main before_destruction = "add_final_return",if com.config.pf_add_final_return then add_final_return else (fun e -> e); "RenameVars",(match com.platform with | Eval -> (fun e -> e) - | Java when defined com Jvm -> (fun e -> e) + | Jvm -> (fun e -> e) | _ -> (fun e -> RenameVars.run tctx.c.curclass.cl_path locals e)); "mark_switch_break_loops",mark_switch_break_loops; ] in diff --git a/src/generators/gencs.ml b/src/generators/gencs.ml deleted file mode 100644 index a30f749df1c..00000000000 --- a/src/generators/gencs.ml +++ /dev/null @@ -1,3562 +0,0 @@ -(* - The Haxe Compiler - Copyright (C) 2005-2019 Haxe Foundation - - This program is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License - as published by the Free Software Foundation; either version 2 - of the License, or (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. - *) -open Extlib_leftovers -open ReflectionCFs -open Globals -open Ast -open Common -open Type -open Gencommon -open Gencommon.SourceWriter -open Texpr.Builder -open Printf -open Option -open ExtString - -type cs_native_constraint = - | CsStruct - | CsClass - | CsUnmanaged - | CsConstructible - | CsConstraint of string - -let get_constraint = function - | CsStruct -> "struct" - | CsClass -> "class" - | CsUnmanaged -> "unmanaged" - | CsConstructible -> "new()" - | CsConstraint s -> s - -let rec is_cs_basic_type t = - match follow t with - | TInst( { cl_path = (["haxe"], "Int32") }, [] ) - | TInst( { cl_path = (["haxe"], "Int64") }, [] ) - | TAbstract ({ a_path = (["cs"], "Int64") },[]) - | TAbstract ({ a_path = (["cs"], "UInt64") },[]) - | TAbstract ({ a_path = ([], "Int") },[]) - | TAbstract ({ a_path = ([], "Float") },[]) - | TAbstract ({ a_path = ([], "Bool") },[]) -> - true - | TAbstract ({ a_path = (["cs"], "Pointer") },_) -> - false - | TAbstract _ when like_float t -> - true - | TAbstract(a,pl) when not (Meta.has Meta.CoreType a.a_meta) -> - is_cs_basic_type (Abstract.get_underlying_type a pl) - | TEnum(e, _) as t when not (is_hxgen_t t) -> true - | TInst(cl, _) when Meta.has Meta.Struct cl.cl_meta -> true - | _ -> false - -let binops_names = List.fold_left (fun acc (op,n) -> PMap.add n op acc) PMap.empty Dotnet.cs_binops -let unops_names = List.fold_left (fun acc (op,n) -> PMap.add n op acc) PMap.empty Dotnet.cs_unops - -let is_tparam t = - match follow t with - | TInst( { cl_kind = KTypeParameter _ }, [] ) -> true - | _ -> false - -let rec is_int_float gen t = - match follow (gen.greal_type t) with - | TInst( { cl_path = (["haxe"], "Int32") }, [] ) - | TAbstract ({ a_path = ([], "Int") },[]) - | TAbstract ({ a_path = ([], "Float") },[]) -> - true - | TAbstract _ when like_float t && not (like_i64 t) -> - true - | TInst( { cl_path = (["haxe"; "lang"], "Null") }, [t] ) -> is_int_float gen t - | _ -> false - -let is_bool t = - match follow t with - | TAbstract ({ a_path = ([], "Bool") },[]) -> - true - | _ -> false - -let is_exactly_bool gen t = - match gen.gfollow#run_f t with - | TAbstract ({ a_path = ([], "Bool") },[]) -> - true - | _ -> false - -let is_dynamic gen t = - match follow (gen.greal_type t) with - | TDynamic _ -> true - | _ -> false - -let is_pointer gen t = - match follow (gen.greal_type t) with - | TAbstract( ( {a_path = ["cs"], "Pointer"}, _ ) ) - | TInst( {cl_path = ["cs"], "Pointer"}, _ ) -> true - | _ -> false - -let rec is_null t = - match t with - | TInst( { cl_path = (["haxe"; "lang"], "Null") }, _ ) - | TAbstract( { a_path = ([], "Null") }, _ ) -> true - | TType( t, tl ) -> is_null (apply_typedef t tl) - | TMono r -> - (match r.tm_type with - | Some t -> is_null t - | _ -> false) - | TLazy f -> - is_null (lazy_type f) - | _ -> false - -let rec get_ptr e = match e.eexpr with - | TParenthesis e | TMeta(_,e) - | TCast(e,_) -> get_ptr e - | TCall( { eexpr = TIdent "__ptr__" }, [ e ] ) -> - Some e - | _ -> None - -let parse_explicit_iface = - let regex = Str.regexp "\\." in - let parse_explicit_iface str = - let split = Str.split regex str in - let rec get_iface split pack = - match split with - | clname :: fn_name :: [] -> fn_name, (List.rev pack, clname) - | pack_piece :: tl -> get_iface tl (pack_piece :: pack) - | _ -> die "" __LOC__ - in - get_iface split [] - in parse_explicit_iface - -let rec change_md = function - | TAbstractDecl(a) when Meta.has Meta.Delegate a.a_meta && not (Meta.has Meta.CoreType a.a_meta) -> - change_md (t_to_md a.a_this) - | TClassDecl( { cl_kind = KAbstractImpl ({ a_this = TInst(impl,_) } as a) }) when Meta.has Meta.Delegate a.a_meta -> - TClassDecl impl - | TClassDecl( { cl_kind = KAbstractImpl (a) }) when Meta.has Meta.CoreType a.a_meta -> - TAbstractDecl a - | md -> md - -(** - Generates method overloads for a method with trailing optional arguments. - E.g. for `function method(a:Int, b:Bool = false) {...}` - generates `function method(a:Int) { method(a, false); }` -*) -let get_overloads_for_optional_args gen cl cf is_static = - match cf.cf_params,cf.cf_kind with - | [],Method (MethNormal | MethDynamic | MethInline) -> - (match cf.cf_expr, follow cf.cf_type with - | Some ({ eexpr = TFunction fn } as method_expr), TFun (args, return_type) -> - let type_params = extract_param_types cl.cl_params in - let rec collect_overloads tf_args_rev args_rev default_values_rev = - match tf_args_rev, args_rev with - | (_, Some default_value) :: rest_tf_args_rev, _ :: rest_args_rev -> - let field_expr = - let cl_type = TInst (cl,type_params) in - if cf.cf_name = "new" then - mk (TConst TThis) cl_type cf.cf_pos - else if is_static then - let class_expr = - mk (TTypeExpr (TClassDecl cl)) cl_type cf.cf_pos - in - mk (TField (class_expr, FStatic(cl,cf))) cf.cf_type cf.cf_pos - else - let this_expr = - mk (TConst TThis) cl_type cf.cf_pos - in - mk (TField (this_expr, FInstance(cl,type_params,cf))) cf.cf_type cf.cf_pos - in - let default_values_rev = default_values_rev @ [default_value] in - let args_exprs = - List.rev ( - default_values_rev - @ (List.map (fun (v,_) -> mk_local v v.v_pos ) rest_tf_args_rev) - ) - in - let call = { fn.tf_expr with eexpr = TCall (field_expr, args_exprs) } in - let fn_body = - if ExtType.is_void (follow return_type) then call - else { fn.tf_expr with eexpr = TReturn (Some call) } - in - let fn = - { fn with tf_args = List.rev rest_tf_args_rev; tf_expr = mk_block fn_body } - in - { cf with - cf_overloads = []; - cf_type = TFun (List.rev rest_args_rev, return_type); - cf_expr = Some { method_expr with eexpr = TFunction fn }; - } :: collect_overloads rest_tf_args_rev rest_args_rev default_values_rev - | _ -> [] - in - collect_overloads (List.rev fn.tf_args) (List.rev args) [] - | _ -> [] - ) - | _ -> [] - -(* used in c#-specific filters to skip some of them for the special haxe.lang.Runtime class *) -let in_runtime_class gen = - match gen.gcurrent_class with - | Some { cl_path = ["haxe";"lang"],"Runtime"} -> true - | _ -> false - -(* ******************************************* *) -(* CSharpSpecificESynf *) -(* ******************************************* *) -(* - Some CSharp-specific syntax filters that must run before ExpressionUnwrap - - dependencies: - It must run before ExprUnwrap, as it may not return valid Expr/Statement expressions - It must run before ClassInstance, as it will detect expressions that need unchanged TTypeExpr -*) -module CSharpSpecificESynf = -struct - let name = "csharp_specific_e" - let priority = solve_deps name [DBefore ExpressionUnwrap.priority; DBefore ClassInstance.priority] - - let get_cl_from_t t = - match follow t with - | TInst(cl,_) -> cl - | _ -> die "" __LOC__ - - let get_ab_from_t t = - match follow t with - | TAbstract(ab,_) -> ab - | _ -> die "" __LOC__ - - let configure gen runtime_cl = - let basic = gen.gcon.basic in - let uint = match get_type gen ([], "UInt") with | TTypeDecl t -> TType(t, []) | TAbstractDecl a -> TAbstract(a, []) | _ -> die "" __LOC__ in - - let rec run e = - match e.eexpr with - (* Std.is() *) - | TCall( - { eexpr = TField( _, FStatic({ cl_path = ([], "Std") }, { cf_name = ("is" | "isOfType") })) }, - [ obj; { eexpr = TTypeExpr(TClassDecl { cl_path = [], "Dynamic" } | TAbstractDecl { a_path = [], "Dynamic" }) }] - ) -> - Type.map_expr run e - | TCall( - { eexpr = TField( _, FStatic({ cl_path = ([], "Std") }, { cf_name = ("is" | "isOfType") }) ) }, - [ obj; { eexpr = TTypeExpr(md) }] - ) -> - let md = change_md md in - let mk_is obj md = - { e with eexpr = TCall( { eexpr = TIdent "__is__"; etype = t_dynamic; epos = e.epos }, [ - obj; - { eexpr = TTypeExpr md; etype = t_dynamic (* this is after all a syntax filter *); epos = e.epos } - ] ) } - in - - let mk_or a b = - { - eexpr = TBinop(Ast.OpBoolOr, a, b); - etype = basic.tbool; - epos = e.epos - } - in - - let wrap_if_needed obj f = - (* introduce temp variable for complex expressions *) - match obj.eexpr with - | TLocal(v) -> f obj - | _ -> - let var = mk_temp "isOfType" obj.etype in - let added = { obj with eexpr = TVar(var, Some(obj)); etype = basic.tvoid } in - let local = mk_local var obj.epos in - { - eexpr = TBlock([ added; f local ]); - etype = basic.tbool; - epos = e.epos - } - in - - let obj = run obj in - (match follow_module follow md with - | TAbstractDecl{ a_path = ([], "Float") } when not (in_runtime_class gen) -> - (* on the special case of seeing if it is a Float, we need to test if both it is a float and if it is an Int *) - let mk_is local = - (* we check if it float or int or uint *) - let eisint = mk_is local (TAbstractDecl (get_ab_from_t basic.tint)) in - let eisuint = mk_is local (TAbstractDecl (get_ab_from_t uint)) in - let eisfloat = mk_is local md in - mk_paren (mk_or eisfloat (mk_or eisint eisuint)) - in - wrap_if_needed obj mk_is - - | TAbstractDecl{ a_path = ([], "Int") } when not (in_runtime_class gen) -> - (* int can be stored in double variable because of anonymous functions, check that case *) - let mk_isint_call local = - { - eexpr = TCall( - mk_static_field_access_infer runtime_cl "isInt" e.epos [], - [ local ] - ); - etype = basic.tbool; - epos = e.epos - } - in - let mk_is local = - let eisint = mk_is local (TAbstractDecl (get_ab_from_t basic.tint)) in - let eisuint = mk_is local (TAbstractDecl (get_ab_from_t uint)) in - mk_paren (mk_or (mk_or eisint eisuint) (mk_isint_call local)) - in - wrap_if_needed obj mk_is - - | TAbstractDecl{ a_path = ([], "UInt") } when not (in_runtime_class gen) -> - (* uint can be stored in double variable because of anonymous functions, check that case *) - let mk_isuint_call local = - { - eexpr = TCall( - mk_static_field_access_infer runtime_cl "isUInt" e.epos [], - [ local ] - ); - etype = basic.tbool; - epos = e.epos - } - in - let mk_is local = - let eisuint = mk_is local (TAbstractDecl (get_ab_from_t uint)) in - mk_paren (mk_or eisuint (mk_isuint_call local)) - in - wrap_if_needed obj mk_is - - | _ -> - mk_is obj md - ) - (* end Std.is() *) - - | TBinop( Ast.OpUShr, e1, e2 ) -> - mk_cast e.etype { e with eexpr = TBinop( Ast.OpShr, mk_cast uint (run e1), run e2 ) } - - | TBinop( Ast.OpAssignOp Ast.OpUShr, e1, e2 ) -> - let mk_ushr local = - { e with eexpr = TBinop(Ast.OpAssign, local, run { e with eexpr = TBinop(Ast.OpUShr, local, run e2) }) } - in - - let mk_local obj = - let var = mk_temp "opUshr" obj.etype in - let added = { obj with eexpr = TVar(var, Some(obj)); etype = basic.tvoid } in - let local = mk_local var obj.epos in - local, added - in - - let e1 = run e1 in - - let ret = match e1.eexpr with - | TField({ eexpr = TLocal _ }, _) - | TField({ eexpr = TTypeExpr _ }, _) - | TArray({ eexpr = TLocal _ }, _) - | TLocal(_) -> - mk_ushr e1 - | TField(fexpr, field) -> - let local, added = mk_local fexpr in - { e with eexpr = TBlock([ added; mk_ushr { e1 with eexpr = TField(local, field) } ]); } - | TArray(ea1, ea2) -> - let local, added = mk_local ea1 in - { e with eexpr = TBlock([ added; mk_ushr { e1 with eexpr = TArray(local, ea2) } ]); } - | _ -> (* invalid left-side expression *) - die "" __LOC__ - in - - ret - - | _ -> Type.map_expr run e - in - gen.gsyntax_filters#add name (PCustom priority) run -end;; - -(* ******************************************* *) -(* CSharpSpecificSynf *) -(* ******************************************* *) - -(* - - Some CSharp-specific syntax filters that can run after ExprUnwrap - - dependencies: - Runs after ExprUnwrap - -*) - -module CSharpSpecificSynf = -struct - let name = "csharp_specific" - let priority = solve_deps name [ DAfter ExpressionUnwrap.priority; DAfter ObjectDeclMap.priority; DAfter ArrayDeclSynf.priority; DAfter HardNullableSynf.priority ] - - let get_cl_from_t t = - match follow t with - | TInst(cl,_) -> cl - | _ -> die "" __LOC__ - - let is_tparam t = - match follow t with - | TInst( { cl_kind = KTypeParameter _ }, _ ) -> true - | _ -> false - - let configure gen runtime_cl = - let basic = gen.gcon.basic in - (* let tchar = match ( get_type gen (["cs"], "Char16") ) with - | TTypeDecl t -> TType(t,[]) - | TAbstractDecl a -> TAbstract(a,[]) - | _ -> die "" __LOC__ - in *) - let string_ext = get_cl ( get_type gen (["haxe";"lang"], "StringExt")) in - let ti64 = match ( get_type gen (["cs"], "Int64") ) with | TTypeDecl t -> TType(t,[]) | TAbstractDecl a -> TAbstract(a,[]) | _ -> die "" __LOC__ in - let boxed_ptr = - if Common.defined gen.gcon Define.Unsafe then - get_cl (get_type gen (["haxe";"lang"], "BoxedPointer")) - (* get_abstract (get_type gen (["cs"],"Pointer")) *) - else - null_class - in - - let is_struct t = (* not basic type *) - match follow t with - | TInst(cl, _) when Meta.has Meta.Struct cl.cl_meta -> true - | _ -> false - in - - let is_cl t = match gen.greal_type t with | TInst ( { cl_path = (["System"], "Type") }, [] ) -> true | _ -> false in - - let fast_cast = Common.defined gen.gcon Define.FastCast in - - let rec run e = - match e.eexpr with - - (* Std.int() *) - | TCall( - { eexpr = TField( _, FStatic({ cl_path = ([], "Std") }, { cf_name = "int" }) ) }, - [obj] - ) -> - run (mk_cast basic.tint obj) - (* end Std.int() *) - - (* TODO: change cf_name *) - | TField(ef, FInstance({ cl_path = [], "String" }, _, { cf_name = "length" })) -> - { e with eexpr = TField(run ef, FDynamic "Length") } - | TField(ef, FInstance({ cl_path = [], "String" }, _, { cf_name = "toLowerCase" })) -> - { e with eexpr = TField(run ef, FDynamic "ToLowerInvariant") } - | TField(ef, FInstance({ cl_path = [], "String" }, _, { cf_name = "toUpperCase" })) -> - { e with eexpr = TField(run ef, FDynamic "ToUpperInvariant") } - - | TCall( { eexpr = TField(_, FStatic({ cl_path = [], "String" }, { cf_name = "fromCharCode" })) }, [cc] ) -> - { e with eexpr = TCall(mk_static_field_access_infer string_ext "fromCharCode" e.epos [], [run cc]) } - | TCall( { eexpr = TField(ef, FInstance({ cl_path = [], "String" }, _, { cf_name = ("charAt" as field) })) }, args ) - | TCall( { eexpr = TField(ef, FInstance({ cl_path = [], "String" }, _, { cf_name = ("charCodeAt" as field) })) }, args ) - | TCall( { eexpr = TField(ef, FInstance({ cl_path = [], "String" }, _, { cf_name = ("indexOf" as field) })) }, args ) - | TCall( { eexpr = TField(ef, FInstance({ cl_path = [], "String" }, _, { cf_name = ("lastIndexOf" as field) })) }, args ) - | TCall( { eexpr = TField(ef, FInstance({ cl_path = [], "String" }, _, { cf_name = ("split" as field) })) }, args ) - | TCall( { eexpr = TField(ef, FInstance({ cl_path = [], "String" }, _, { cf_name = ("substring" as field) })) }, args ) - | TCall( { eexpr = TField(ef, FInstance({ cl_path = [], "String" }, _, { cf_name = ("substr" as field) })) }, args ) -> - { e with eexpr = TCall(mk_static_field_access_infer string_ext field e.epos [], [run ef] @ (List.map run args)) } - | TCall( { eexpr = TField(ef, FInstance({ cl_path = [], "String" }, _, { cf_name = ("toString") })) }, [] ) -> - run ef - | TNew( { cl_path = ([], "String") }, [], [p] ) -> run p (* new String(myString) -> myString *) - - | TCast(expr, _) when like_float expr.etype && is_pointer gen e.etype -> - let expr = run expr in - mk_cast e.etype (mk_cast ti64 expr) - | TCast(expr, _) when is_dynamic gen expr.etype && is_pointer gen e.etype -> - (match get_ptr expr with - | None -> - (* unboxing *) - let expr = run expr in - mk_cast e.etype (mk_field_access gen (mk_cast (TInst(boxed_ptr,[])) expr) "value" e.epos) - | Some e -> - run e) - | TCast(expr, _) when is_pointer gen expr.etype && is_dynamic gen e.etype -> - (match get_ptr expr with - | None -> - (* boxing *) - let expr = run expr in - { e with eexpr = TNew(boxed_ptr,[],[expr]) } - | Some e -> - run e) - | TCast(expr, _) when is_bool e.etype && is_dynamic gen expr.etype -> - { - eexpr = TCall( - mk_static_field_access_infer runtime_cl "toBool" expr.epos [], - [ run expr ] - ); - etype = basic.tbool; - epos = e.epos - } - | TCast(expr, _) when is_int_float gen e.etype && is_dynamic gen expr.etype && ( Common.defined gen.gcon Define.EraseGenerics || not (is_null e.etype) ) && not (in_runtime_class gen) -> - let needs_cast = match gen.gfollow#run_f e.etype with - | TInst _ -> false - | _ -> true - in - - let fun_name = if like_int e.etype then "toInt" else "toDouble" in - - let ret = { - eexpr = TCall( - mk_static_field_access_infer runtime_cl fun_name expr.epos [], - [ run expr ] - ); - etype = basic.tint; - epos = expr.epos - } in - - if needs_cast then mk_cast e.etype ret else ret - - | TCast(expr, _) when Common.defined gen.gcon Define.EraseGenerics && like_i64 e.etype && is_dynamic gen expr.etype && not (in_runtime_class gen) -> - { - eexpr = TCall( - mk_static_field_access_infer runtime_cl "toLong" expr.epos [], - [ run expr ] - ); - etype = ti64; - epos = expr.epos - } - - | TCast(expr, Some(TClassDecl cls)) when fast_cast && cls == null_class -> - if is_cs_basic_type (gen.greal_type e.etype) || is_tparam (gen.greal_type e.etype) then - { e with eexpr = TCast(run expr, Some(TClassDecl null_class)) } - else - { e with eexpr = TCall(mk (TIdent "__as__") t_dynamic e.epos, [run expr]) } - - | TCast(expr, _) when (is_string e.etype) && (not (is_string expr.etype)) && not (in_runtime_class gen) -> - { e with eexpr = TCall( mk_static_field_access_infer runtime_cl "toString" expr.epos [], [run expr] ) } - - | TCast(expr, _) when is_tparam e.etype && not (in_runtime_class gen) && not (Common.defined gen.gcon Define.EraseGenerics) -> - let static = mk_static_field_access_infer (runtime_cl) "genericCast" e.epos [e.etype] in - { e with eexpr = TCall(static, [mk (TIdent "$type_param") e.etype expr.epos; run expr]); } - - | TBinop( (Ast.OpNotEq as op), e1, e2) - | TBinop( (Ast.OpEq as op), e1, e2) when is_struct e1.etype || is_struct e2.etype -> - let mk_ret e = match op with | Ast.OpNotEq -> { e with eexpr = TUnop(Ast.Not, Ast.Prefix, e) } | _ -> e in - mk_ret { e with - eexpr = TCall({ - eexpr = TField(run e1, FDynamic "Equals"); - etype = TFun(["obj1",false,t_dynamic;], basic.tbool); - epos = e1.epos - }, [ run e2 ]) - } - - | TBinop ( (Ast.OpEq as op), e1, e2 ) - | TBinop ( (Ast.OpNotEq as op), e1, e2 ) when is_cl e1.etype && not (in_runtime_class gen) -> - let static = mk_static_field_access_infer (runtime_cl) "typeEq" e.epos [] in - let ret = { e with eexpr = TCall(static, [run e1; run e2]); } in - if op = Ast.OpNotEq then - { ret with eexpr = TUnop(Ast.Not, Ast.Prefix, ret) } - else - ret - - | _ -> Type.map_expr run e - in - gen.gsyntax_filters#add name (PCustom priority) run -end;; - -let add_cast_handler gen = - let basic = gen.gcon.basic in - (* - starting to set gtparam_cast. - *) - - (* NativeArray: the most important. *) - - (* - var new_arr = new NativeArray(old_arr.Length); - var i = -1; - while( i < old_arr.Length ) - { - new_arr[i] = (TO_T) old_arr[i]; - } - *) - - let native_arr_cl = get_cl ( get_type gen (["cs"], "NativeArray") ) in - - let get_narr_param t = match follow t with - | TInst({ cl_path = (["cs"], "NativeArray") }, [param]) -> param - | _ -> die "" __LOC__ - in - - let gtparam_cast_native_array e to_t = - let old_param = get_narr_param e.etype in - let new_param = get_narr_param to_t in - - let new_v = mk_temp "new_arr" to_t in - let i = mk_temp "i" basic.tint in - let old_len = mk_field_access gen e "Length" e.epos in - let obj_v = mk_temp "obj" t_dynamic in - let check_null = {eexpr = TBinop(Ast.OpNotEq, e, null e.etype e.epos); etype = basic.tbool; epos = e.epos} in - let block = [ - { - eexpr = TVar( - new_v, Some( { - eexpr = TNew(native_arr_cl, [new_param], [old_len] ); - etype = to_t; - epos = e.epos - } ) - ); - etype = basic.tvoid; - epos = e.epos - }; - { - eexpr = TVar(i, Some( make_int gen.gcon.basic (-1) e.epos )); - etype = basic.tvoid; - epos = e.epos - }; - { - eexpr = TWhile( - { - eexpr = TBinop( - Ast.OpLt, - { eexpr = TUnop(Ast.Increment, Ast.Prefix, mk_local i e.epos); etype = basic.tint; epos = e.epos }, - old_len - ); - etype = basic.tbool; - epos = e.epos - }, - { eexpr = TBlock [ - { - eexpr = TVar(obj_v, Some (mk_cast t_dynamic { eexpr = TArray(e, mk_local i e.epos); etype = old_param; epos = e.epos })); - etype = basic.tvoid; - epos = e.epos - }; - { - eexpr = TIf({ - eexpr = TBinop(Ast.OpNotEq, mk_local obj_v e.epos, null e.etype e.epos); - etype = basic.tbool; - epos = e.epos - }, - { - eexpr = TBinop( - Ast.OpAssign, - { eexpr = TArray(mk_local new_v e.epos, mk_local i e.epos); etype = new_param; epos = e.epos }, - mk_cast new_param (mk_local obj_v e.epos) - ); - etype = new_param; - epos = e.epos - }, - None); - etype = basic.tvoid; - epos = e.epos - } - ]; etype = basic.tvoid; epos = e.epos }, - Ast.NormalWhile - ); - etype = basic.tvoid; - epos = e.epos; - }; - mk_local new_v e.epos - ] in - { - eexpr = TIf( - check_null, - { - eexpr = TBlock(block); - etype = to_t; - epos = e.epos; - }, - Some(null new_v.v_type e.epos) - ); - etype = to_t; - epos = e.epos; - } - in - - Hashtbl.add gen.gtparam_cast (["cs"], "NativeArray") gtparam_cast_native_array; - Hashtbl.add gen.gtparam_cast (["haxe";"lang"], "Null") (fun e to_t -> mk_cast to_t e) - (* end set gtparam_cast *) - -let connecting_string = "?" (* ? see list here http://www.fileformat.info/info/unicode/category/index.htm and here for C# http://msdn.microsoft.com/en-us/library/aa664670.aspx *) -let default_package = "cs" (* I'm having this separated as I'm still not happy with having a cs package. Maybe dotnet would be better? *) -let strict_mode = ref false (* strict mode is so we can check for unexpected information *) - -(* reserved c# words *) -let reserved = let res = Hashtbl.create 120 in - List.iter (fun lst -> Hashtbl.add res lst ("@" ^ lst)) ["abstract"; "as"; "base"; "bool"; "break"; "byte"; "case"; "catch"; "char"; "checked"; "class"; - "const"; "continue"; "decimal"; "default"; "delegate"; "do"; "double"; "else"; "enum"; "event"; "explicit"; - "extern"; "false"; "finally"; "fixed"; "float"; "for"; "foreach"; "goto"; "if"; "implicit"; "in"; "int"; - "interface"; "internal"; "is"; "lock"; "long"; "namespace"; "new"; "null"; "object"; "operator"; "out"; "override"; - "params"; "private"; "protected"; "public"; "readonly"; "ref"; "return"; "sbyte"; "sealed"; "short"; "sizeof"; - "stackalloc"; "static"; "string"; "struct"; "switch"; "this"; "throw"; "true"; "try"; "typeof"; "uint"; "ulong"; - "unchecked"; "unsafe"; "ushort"; "using"; "virtual"; "volatile"; "void"; "while"; "add"; "ascending"; "by"; "descending"; - "dynamic"; "equals"; "from"; "get"; "global"; "group"; "into"; "join"; "let"; "on"; "orderby"; "partial"; - "remove"; "select"; "set"; "value"; "var"; "where"; "yield"; "await"]; - res - -let dynamic_anon = mk_anon (ref Closed) - -let rec get_class_modifiers meta cl_type cl_access cl_modifiers = - match meta with - | [] -> cl_type,cl_access,cl_modifiers - | (Meta.Struct,[],_) :: meta -> get_class_modifiers meta "struct" cl_access cl_modifiers - | (Meta.Protected,[],_) :: meta -> get_class_modifiers meta cl_type "protected" cl_modifiers - | (Meta.Internal,[],_) :: meta -> get_class_modifiers meta cl_type "internal" cl_modifiers - (* no abstract for now | (":abstract",[],_) :: meta -> get_class_modifiers meta cl_type cl_access ("abstract" :: cl_modifiers) - | (":static",[],_) :: meta -> get_class_modifiers meta cl_type cl_access ("static" :: cl_modifiers) TODO: support those types *) - | (Meta.Unsafe,[],_) :: meta -> get_class_modifiers meta cl_type cl_access ("unsafe" :: cl_modifiers) - | _ :: meta -> get_class_modifiers meta cl_type cl_access cl_modifiers - -let rec get_fun_modifiers meta access modifiers = - match meta with - | [] -> access,modifiers - | (Meta.Private,[],_) :: meta -> get_fun_modifiers meta "private" modifiers - | (Meta.Protected,[],_) :: meta -> get_fun_modifiers meta "protected" modifiers - | (Meta.Internal,[],_) :: meta -> get_fun_modifiers meta "internal" modifiers - | (Meta.ReadOnly,[],_) :: meta -> get_fun_modifiers meta access ("readonly" :: modifiers) - | (Meta.Unsafe,[],_) :: meta -> get_fun_modifiers meta access ("unsafe" :: modifiers) - | (Meta.Volatile,[],_) :: meta -> get_fun_modifiers meta access ("volatile" :: modifiers) - | (Meta.Custom ("?prop_impl" | ":cs_event_impl"),[],_) :: meta -> get_fun_modifiers meta "private" modifiers - | _ :: meta -> get_fun_modifiers meta access modifiers - -let generate con = - (try - let gen = new_ctx con in - let basic = con.basic in - - if Common.defined_value con Define.Dce = "no" then begin - let m = { null_module with m_id = alloc_mid(); m_path = ["haxe";"lang"],"DceNo" } in - let cl = mk_class m (["haxe";"lang"],"DceNo") null_pos in - gen.gtypes_list <- (TClassDecl cl) :: gen.gtypes_list; - Hashtbl.add gen.gtypes cl.cl_path (TClassDecl cl) - end; - - (* make the basic functions in C# *) - let type_cl = get_cl ( get_type gen (["System"], "Type")) in - let basic_fns = - [ - mk_class_field "Equals" (TFun(["obj",false,t_dynamic], basic.tbool)) true null_pos (Method MethNormal) []; - mk_class_field "ToString" (TFun([], basic.tstring)) true null_pos (Method MethNormal) []; - mk_class_field "GetHashCode" (TFun([], basic.tint)) true null_pos (Method MethNormal) []; - mk_class_field "GetType" (TFun([], TInst(type_cl, []))) true null_pos (Method MethNormal) []; - ] in - List.iter (fun cf -> gen.gbase_class_fields <- PMap.add cf.cf_name cf gen.gbase_class_fields) basic_fns; - - let native_arr_cl = get_cl ( get_type gen (["cs"], "NativeArray") ) in - gen.gclasses.nativearray <- (fun t -> TInst(native_arr_cl,[t])); - gen.gclasses.nativearray_type <- (function TInst(_,[t]) -> t | _ -> die "" __LOC__); - gen.gclasses.nativearray_len <- (fun e p -> mk_field_access gen e "Length" p); - - let erase_generics = Common.defined gen.gcon Define.EraseGenerics in - let fn_cl = get_cl (get_type gen (["haxe";"lang"],"Function")) in - let null_t = if erase_generics then null_class else (get_cl (get_type gen (["haxe";"lang"],"Null")) ) in - let runtime_cl = get_cl (get_type gen (["haxe";"lang"],"Runtime")) in - let no_root = Common.defined gen.gcon Define.NoRoot in - let change_id name = try - Hashtbl.find reserved name - with | Not_found -> - let ret = String.concat "." (String.nsplit name "#") in - List.hd (String.nsplit ret "`") - in - - let change_clname n = change_id n in - - let change_ns_params_root md ns params = - let ns,params = List.fold_left (fun (ns,params) nspart -> try - let part, nparams = String.split nspart "`" in - let nparams = int_of_string nparams in - let rec loop i needed params = - if i = nparams then - (List.rev needed,params) - else - loop (i+1) (List.hd params :: needed) (List.tl params) - in - let needed,params = loop 0 [] params in - let part = change_id part in - (part ^ "<" ^ (String.concat ", " needed) ^ ">")::ns, params - with _ -> (* Invalid_string / int_of_string *) - (change_id nspart)::ns, params - ) ([],params) ns - in - List.rev ns,params - in - - let change_ns_params md params ns = if no_root then ( - let needs_root md = is_hxgen md || match md with - | TClassDecl cl when (Meta.has Meta.Enum cl.cl_meta) && (Meta.has Meta.CompilerGenerated cl.cl_meta) -> - (* this will match our compiler-generated enum constructor classes *) - true - | _ -> - false - in - match ns with - | [] when needs_root md -> ["haxe";"root"], params - | [s] when (t_infos md).mt_private && needs_root md -> ["haxe";"root";s], params - | [] -> (match md with - | TClassDecl { cl_path = ([],"Std" | [],"Math") } -> ["haxe";"root"], params - | TClassDecl { cl_meta = m } when Meta.has Meta.Enum m -> ["haxe";"root"], params - | _ -> [], params) - | ns when params = [] -> List.map change_id ns, params - | ns -> - change_ns_params_root md ns params) - else if params = [] then - List.map change_id ns, params - else - change_ns_params_root md ns params - in - - let change_ns md ns = - let ns, _ = change_ns_params md [] ns in - ns - in - - let change_class_field cl name = - let change_ctor name = if name = "new" then snd cl.cl_path else name in - let rec gen name = - let name = name ^ "_" ^ name in - if PMap.mem name cl.cl_fields || PMap.mem name cl.cl_statics then gen name - else name - in - change_id (if name = snd cl.cl_path then gen name else (change_ctor name)) - in - let change_enum_field enum name = - let rec gen name = - let name = name ^ "_" ^ name in - if PMap.mem name enum.e_constrs then gen name - else name - in - change_id (if name = snd enum.e_path then gen name else name) - in - let change_field = change_id in - let write_id w name = write w (change_id name) in - let write_class_field cl w name = write w (change_class_field cl name) in - let write_enum_field enum w name = write w (change_enum_field enum name) in - let write_field w name = write w (change_field name) in - let get_write_field field_access = - match field_access with - | FInstance (cl,_,f) | FStatic (cl,f) | FClosure (Some (cl,_),f) -> write_class_field cl - | FEnum (enum,f) -> write_enum_field enum - | _ -> write_field - in - - let ptr = - if Common.defined gen.gcon Define.Unsafe then - get_abstract (get_type gen (["cs"],"Pointer")) - else - null_abstract - in - - let is_hxgeneric md = - RealTypeParams.is_hxgeneric md - in - - let rec field_is_hxgeneric e = match e.eexpr with - | TParenthesis e | TMeta(_,e) -> field_is_hxgeneric e - | TField(_, (FStatic(cl,_) | FInstance(cl,_,_)) ) -> - (* print_endline ("is_hxgeneric " ^ s_type_path cl.cl_path ^ " : " ^ string_of_bool (is_hxgeneric (TClassDecl cl))); *) - is_hxgeneric (TClassDecl cl) - | _ -> true - in - - gen.gfollow#add "follow_basic" PZero (fun t -> match t with - | TAbstract ({ a_path = ([], "Bool") },[]) - | TAbstract ({ a_path = ([], "Void") },[]) - | TAbstract ({ a_path = ([],"Float") },[]) - | TAbstract ({ a_path = ([],"Int") },[]) - | TAbstract ({ a_path = [],"UInt" },[]) - | TType ({ t_path = ["cs"], "Int64" },[]) - | TAbstract ({ a_path = ["cs"], "Int64" },[]) - | TType ({ t_path = ["cs"],"UInt64" },[]) - | TAbstract ({ a_path = ["cs"],"UInt64" },[]) - | TType ({ t_path = ["cs"],"UInt8" },[]) - | TAbstract ({ a_path = ["cs"],"UInt8" },[]) - | TType ({ t_path = ["cs"],"Int8" },[]) - | TAbstract ({ a_path = ["cs"],"Int8" },[]) - | TType ({ t_path = ["cs"],"Int16" },[]) - | TAbstract ({ a_path = ["cs"],"Int16" },[]) - | TType ({ t_path = ["cs"],"UInt16" },[]) - | TAbstract ({ a_path = ["cs"],"UInt16" },[]) - | TType ({ t_path = ["cs"],"Char16" },[]) - | TAbstract ({ a_path = ["cs"],"Char16" },[]) - | TType ({ t_path = ["cs"],"Ref" },_) - | TAbstract ({ a_path = ["cs"],"Ref" },_) - | TType ({ t_path = ["cs"],"Out" },_) - | TAbstract ({ a_path = ["cs"],"Out" },_) - | TType ({ t_path = [],"Single" },[]) - | TAbstract ({ a_path = [],"Single" },[]) -> Some t - | TAbstract (({ a_path = [],"Null" } as tab),[t2]) -> - Some (TAbstract(tab,[follow (gen.gfollow#run_f t2)])) - | TAbstract({ a_path = ["cs"],"PointerAccess" },[t]) -> - Some (TAbstract(ptr,[t])) - | TAbstract (a, pl) when not (Meta.has Meta.CoreType a.a_meta) -> - Some (gen.gfollow#run_f ( Abstract.get_underlying_type a pl) ) - | TAbstract( { a_path = ([], "EnumValue") }, _ ) - | TInst( { cl_path = ([], "EnumValue") }, _ ) -> Some t_dynamic - | _ -> None); - - let module_s_params md params = - let md = change_md md in - let path = (t_infos md).mt_path in - match path with - | ([], "String") -> "string", params - | ([], "Null") -> s_type_path (change_ns md ["haxe"; "lang"], change_clname "Null"), params - | (ns,clname) -> - let ns, params = change_ns_params md params ns in - s_type_path (ns, change_clname clname), params - in - - let module_s md = - fst (module_s_params md []) - in - - let ifaces = Hashtbl.create 1 in - - let ti64 = match ( get_type gen (["cs"], "Int64") ) with | TTypeDecl t -> TType(t,[]) | TAbstractDecl a -> TAbstract(a,[]) | _ -> die "" __LOC__ in - - let ttype = get_cl ( get_type gen (["System"], "Type") ) in - - let has_tdyn tl = - List.exists (fun t -> match follow t with - | TDynamic _ | TMono _ -> true - | _ -> false - ) tl - in - - let rec real_type stack t = - let t = gen.gfollow#run_f t in - if List.exists (fast_eq t) stack then - t_dynamic - else begin - let stack = t :: stack in - let ret = match t with - | TAbstract({ a_path = ([], "Null") }, [t]) -> - (* - Null<> handling is a little tricky. - It will only change to haxe.lang.Null<> when the actual type is non-nullable or a type parameter - It works on cases such as Hash returning Null since cast_detect will invoke real_type at the original type, - Null, which will then return the type haxe.lang.Null<> - *) - if erase_generics then - if is_cs_basic_type t then - t_dynamic - else - real_type stack t - else - (match real_type stack t with - | TInst( { cl_kind = KTypeParameter _ }, _ ) -> TInst(null_t, [t]) - | t when is_cs_basic_type t -> TInst(null_t, [t]) - | _ -> real_type stack t) - | TAbstract (a, pl) when not (Meta.has Meta.CoreType a.a_meta) -> - real_type stack (Abstract.get_underlying_type a pl) - | TAbstract ({ a_path = (["cs";"_Flags"], "EnumUnderlying") }, [t]) -> - real_type stack t - | TInst( { cl_path = (["cs";"system"], "String") }, [] ) -> - gen.gcon.basic.tstring; - | TInst( { cl_path = (["haxe"], "Int32") }, [] ) -> gen.gcon.basic.tint - | TInst( { cl_path = (["haxe"], "Int64") }, [] ) -> ti64 - | TAbstract( { a_path = [],"Class" }, _ ) - | TAbstract( { a_path = [],"Enum" }, _ ) - | TAbstract( { a_path = (["haxe"]),"Rest" }, _ ) - | TType( { t_path = (["haxe";"extern"]),"Rest" }, _ ) - | TInst( { cl_path = ([], "Class") }, _ ) - | TInst( { cl_path = ([], "Enum") }, _ ) -> TInst(ttype,[]) - | TInst( ({ cl_kind = KTypeParameter _ } as cl), _ ) when erase_generics && not (Meta.has Meta.NativeGeneric cl.cl_meta) -> - t_dynamic - | TInst({ cl_kind = KExpr _ }, _) -> t_dynamic - | TEnum(_, []) - | TInst(_, []) -> t - | TInst(cl, params) when - has_tdyn params && - Hashtbl.mem ifaces cl.cl_path -> - TInst(Hashtbl.find ifaces cl.cl_path, []) - | TEnum(e, params) -> - TEnum(e, List.map (fun _ -> t_dynamic) params) - | TInst(cl, params) when Meta.has Meta.Enum cl.cl_meta -> - TInst(cl, List.map (fun _ -> t_dynamic) params) - | TInst(cl, params) -> TInst(cl, change_param_type stack (TClassDecl cl) params) - | TAbstract _ - | TType _ -> t - | TAnon (anon) when (match !(anon.a_status) with | ClassStatics _ | EnumStatics _ | AbstractStatics _ -> true | _ -> false) -> t - | TFun _ -> TInst(fn_cl,[]) - | _ -> t_dynamic - in - ret - end - and - - (* - On hxcs, the only type parameters allowed to be declared are the basic c# types. - That's made like this to avoid casting problems when type parameters in this case - add nothing to performance, since the memory layout is always the same. - - To avoid confusion between Generic (which has a different meaning in hxcs AST), - all those references are using dynamic_anon, which means Generic<{}> - *) - change_param_type stack md tl = - let types = match md with - | TClassDecl c -> c.cl_params - | TEnumDecl e -> [] - | TAbstractDecl a -> a.a_params - | TTypeDecl t -> t.t_params - in - let is_hxgeneric = if types = [] then is_hxgen md else (RealTypeParams.is_hxgeneric md) in - let ret t = - let t_changed = real_type stack t in - match is_hxgeneric, t_changed with - (* - Because Null<> types need a special compiler treatment for many operations (e.g. boxing/unboxing), - Null<> type parameters will be transformed into Dynamic. - *) - | _, TInst ( { cl_path = (["haxe";"lang"], "Null") }, _ ) -> dynamic_anon - | false, _ -> t - | true, TInst ( { cl_path = ([], "String") }, _ ) -> t - | true, TInst ( { cl_kind = KTypeParameter _ }, _ ) -> t - | true, TInst _ - | true, TEnum _ - | true, TAbstract _ when is_cs_basic_type t_changed -> t - | true, TDynamic _ -> t - | true, x -> - dynamic_anon - in - if is_hxgeneric && (erase_generics || List.exists (fun t -> match follow t with | TDynamic _ -> true | _ -> false) tl) then - List.map (fun _ -> t_dynamic) tl - else - List.map ret tl - in - - let real_type = real_type [] - and change_param_type = change_param_type [] in - - let is_dynamic t = match real_type t with - | TMono _ | TDynamic _ - | TInst({ cl_kind = KTypeParameter _ }, _) -> true - | TAnon anon -> - (match !(anon.a_status) with - | EnumStatics _ | ClassStatics _ -> false - | _ -> true - ) - | _ -> false - in - - let rec t_s t = - match real_type t with - (* basic types *) - | TAbstract ({ a_path = ([], "Bool") },[]) -> "bool" - | TAbstract ({ a_path = ([], "Void") },[]) -> "object" - | TAbstract ({ a_path = ([],"Float") },[]) -> "double" - | TAbstract ({ a_path = ([],"Int") },[]) -> "int" - | TAbstract ({ a_path = [],"UInt" },[]) -> "uint" - | TType ({ t_path = ["cs"], "Int64" },[]) - | TAbstract ({ a_path = ["cs"], "Int64" },[]) -> "long" - | TType ({ t_path = ["cs"],"UInt64" },[]) - | TAbstract ({ a_path = ["cs"],"UInt64" },[]) -> "ulong" - | TType ({ t_path = ["cs"],"UInt8" },[]) - | TAbstract ({ a_path = ["cs"],"UInt8" },[]) -> "byte" - | TType ({ t_path = ["cs"],"Int8" },[]) - | TAbstract ({ a_path = ["cs"],"Int8" },[]) -> "sbyte" - | TType ({ t_path = ["cs"],"Int16" },[]) - | TAbstract ({ a_path = ["cs"],"Int16" },[]) -> "short" - | TType ({ t_path = ["cs"],"UInt16" },[]) - | TAbstract ({ a_path = ["cs"],"UInt16" },[]) -> "ushort" - | TType ({ t_path = ["cs"],"Char16" },[]) - | TAbstract ({ a_path = ["cs"],"Char16" },[]) -> "char" - | TType ({ t_path = [],"Single" },[]) - | TAbstract ({ a_path = [],"Single" },[]) -> "float" - | TInst ({ cl_path = ["haxe"],"Int32" },[]) - | TAbstract ({ a_path = ["haxe"],"Int32" },[]) -> "int" - | TInst ({ cl_path = ["haxe"],"Int64" },[]) - | TAbstract ({ a_path = ["haxe"],"Int64" },[]) -> "long" - | TInst ({ cl_path = ([], "Dynamic") },_) - | TAbstract ({ a_path = ([], "Dynamic") },_) -> "object" - | TType ({ t_path = ["cs"],"Out" },[t]) - | TAbstract ({ a_path = ["cs"],"Out" },[t]) - | TType ({ t_path = ["cs"],"Ref" },[t]) - | TAbstract ({ a_path = ["cs"],"Ref" },[t]) -> t_s t - | TInst({ cl_path = (["cs"], "NativeArray") }, [param]) -> - let rec check_t_s t = - match real_type t with - | TInst({ cl_path = (["cs"], "NativeArray") }, [param]) -> - (check_t_s param) ^ "[]" - | _ -> t_s (run_follow gen t) - in - (check_t_s param) ^ "[]" - | TInst({ cl_path = (["cs"], "Pointer") },[t]) - | TAbstract({ a_path = (["cs"], "Pointer") },[t])-> - let ret = t_s t in - (if ret = "object" then "void" else ret) ^ "*" - (* end of basic types *) - | TInst ({ cl_kind = KTypeParameter _; cl_path=p }, []) -> snd p - | TMono r -> (match r.tm_type with | None -> "object" | Some t -> t_s (run_follow gen t)) - | TInst ({ cl_path = [], "String" }, []) -> "string" - | TEnum (e, params) -> ("global::" ^ (module_s (TEnumDecl e))) - | TInst (cl, _ :: _) when Meta.has Meta.Enum cl.cl_meta -> - "global::" ^ module_s (TClassDecl cl) - | TInst (({ cl_path = p } as cl), params) -> (path_param_s (TClassDecl cl) p params) - | TType (({ t_path = p } as t), params) -> (path_param_s (TTypeDecl t) p params) - | TAnon (anon) -> - (match !(anon.a_status) with - | ClassStatics _ | EnumStatics _ -> "System.Type" - | _ -> "object") - | TDynamic _ -> "object" - | TAbstract(a,pl) when not (Meta.has Meta.CoreType a.a_meta) -> - t_s (Abstract.get_underlying_type a pl) - (* No Lazy type nor Function type made. That's because function types will be at this point be converted into other types *) - | _ -> if !strict_mode then begin trace ("[ !TypeError " ^ (Type.s_type (Type.print_context()) t) ^ " ]"); die "" __LOC__ end else "[ !TypeError " ^ (Type.s_type (Type.print_context()) t) ^ " ]" - - and path_param_s md path params = - match params with - | [] -> "global::" ^ module_s md - | _ when erase_generics && is_hxgeneric md -> - "global::" ^ module_s md - | _ -> - let params = (List.map (fun t -> t_s t) (change_param_type md params)) in - let str,params = module_s_params md params in - if params = [] then - "global::" ^ str - else - sprintf "global::%s<%s>" str (String.concat ", " params) - in - - let rett_s t = - match t with - | TAbstract ({ a_path = ([], "Void") },[]) -> "void" - | _ -> t_s t - in - - let escape ichar b = - match ichar with - | 92 (* \ *) -> Buffer.add_string b "\\\\" - | 39 (* ' *) -> Buffer.add_string b "\\\'" - | 34 -> Buffer.add_string b "\\\"" - | 13 (* \r *) -> Buffer.add_string b "\\r" - | 10 (* \n *) -> Buffer.add_string b "\\n" - | 9 (* \t *) -> Buffer.add_string b "\\t" - | c when c < 32 || (c >= 127 && c <= 0xFFFF) -> Buffer.add_string b (Printf.sprintf "\\u%.4x" c) - | c when c > 0xFFFF -> Buffer.add_string b (Printf.sprintf "\\U%.8x" c) - | c -> Buffer.add_char b (Char.chr c) - in - - let escape s = - let b = Buffer.create 0 in - (try - UTF8.validate s; - UTF8.iter (fun c -> escape (UCharExt.code c) b) s - with - UTF8.Malformed_code -> - String.iter (fun c -> escape (Char.code c) b) s - ); - Buffer.contents b - in - - let has_semicolon e = - match e.eexpr with - | TBlock _ | TFor _ | TSwitch _ | TTry _ | TIf _ -> false - | TWhile (_,_,flag) when flag = Ast.NormalWhile -> false - | _ -> true - in - - let in_value = ref false in - - let md_s md = - let md = follow_module (gen.gfollow#run_f) md in - match md with - | TClassDecl ({ cl_params = [] } as cl) -> - t_s (TInst(cl,[])) - | TClassDecl (cl) when not (is_hxgen md) -> - t_s (TInst(cl,List.map (fun t -> t_dynamic) cl.cl_params)) - | TEnumDecl ({ e_params = [] } as e) -> - t_s (TEnum(e,[])) - | TEnumDecl (e) when not (is_hxgen md) -> - t_s (TEnum(e,List.map (fun t -> t_dynamic) e.e_params)) - | TClassDecl cl -> - t_s (TInst(cl,[])) - | TEnumDecl e -> - t_s (TEnum(e,[])) - | TTypeDecl t -> - t_s (TType(t, List.map (fun t -> t_dynamic) t.t_params)) - | TAbstractDecl a -> - t_s (TAbstract(a, List.map(fun t -> t_dynamic) a.a_params)) - in - - let rec ensure_local e explain = - match e.eexpr with - | TLocal _ -> e - | TCast(e,_) - | TParenthesis e | TMeta(_,e) -> ensure_local e explain - | _ -> gen.gcon.error ("This function argument " ^ explain ^ " must be a local variable.") e.epos; e - in - - let rec ensure_refout e explain = - match e.eexpr with - | TField _ | TLocal _ -> e - | TCast(e,_) - | TParenthesis e | TMeta(_,e) -> ensure_refout e explain - | _ -> gen.gcon.error ("This function argument " ^ explain ^ " must be a local variable.") e.epos; e - in - - let last_line = ref (-1) in - let begin_block w = write w "{"; push_indent w; newline w; last_line := -1 in - let end_block w = pop_indent w; (if w.sw_has_content then newline w); write w "}"; newline w; last_line := -1 in - let skip_line_directives = (not gen.gcon.debug && not (Common.defined gen.gcon Define.NoCompilation)) || Common.defined gen.gcon Define.RealPosition in - let line_directive = - if skip_line_directives then - fun w p -> () - else fun w p -> - if p.pfile <> null_pos.pfile then (* Compiler Error CS1560 https://msdn.microsoft.com/en-us/library/z3t5e5sw(v=vs.90).aspx *) - let cur_line = Lexer.get_error_line p in - let file = Path.get_full_path p.pfile in - if cur_line <> ((!last_line)+1) then - let line = StringHelper.s_escape file in - if String.length line <= 256 then - begin print w "#line %d \"%s\"" cur_line line; newline w end - else (* Compiler Error CS1560 https://msdn.microsoft.com/en-us/library/z3t5e5sw(v=vs.90).aspx *) - begin print w "//line %d \"%s\"" cur_line line; newline w end; - last_line := cur_line - in - let line_reset_directive = - if skip_line_directives then - fun w -> () - else fun w -> - print w "#line default" - in - - let rec extract_tparams params el = - match el with - | ({ eexpr = TIdent "$type_param" } as tp) :: tl -> - extract_tparams (tp.etype :: params) tl - | _ -> (params, el) - in - - let is_extern_prop t name = match follow (run_follow gen t), field_access gen t name with - | TInst(cl, _), FNotFound when (has_class_flag cl CExtern) && (has_class_flag cl CInterface) -> - not (is_hxgen (TClassDecl cl)) - | _, FClassField(_,_,decl,v,_,t,_) -> - not (Type.is_physical_field v) && (Meta.has Meta.Property v.cf_meta || ((has_class_flag decl CExtern) && not (is_hxgen (TClassDecl decl)))) - | _ -> false - in - - let is_event t name = match follow (run_follow gen t), field_access gen t name with - | TInst(cl, _), FNotFound when (has_class_flag cl CExtern) && (has_class_flag cl CInterface) -> - not (is_hxgen (TClassDecl cl)) - | _, FClassField(_,_,decl,v,_,_,_) -> - Meta.has Meta.Event v.cf_meta - | _ -> false - in - - let extract_statements expr = - let ret = ref [] in - let rec loop expr = match expr.eexpr with - | TCall ({ eexpr = TIdent ("__is__" | "__typeof__" | "__array__" | "__sizeof__" | "__delegate__")}, el) -> - List.iter loop el - | TNew ({ cl_path = (["cs"], "NativeArray") }, params, [ size ]) -> - () - | TUnop (Ast.Increment, _, _) - | TUnop (Ast.Decrement, _, _) - | TBinop (Ast.OpAssign, _, _) - | TBinop (Ast.OpAssignOp _, _, _) - | TIdent "__fallback__" - | TIdent "__sbreak__" -> - ret := expr :: !ret - | TConst _ - | TLocal _ - | TArray _ - | TBinop _ - | TField _ - | TEnumParameter _ - | TTypeExpr _ - | TObjectDecl _ - | TArrayDecl _ - | TCast _ - | TParenthesis _ - | TUnop _ -> - Type.iter loop expr - | TFunction _ -> () (* do not extract parameters from inside of it *) - | _ -> - ret := expr :: !ret - in - loop expr; - (* [expr] *) - List.rev !ret - in - - let expr_s is_in_value w e = - last_line := -1; - in_value := is_in_value; - let rec expr_s w e = - let was_in_value = !in_value in - in_value := true; - (match e.eexpr with - | TCall({ eexpr = TField(ef,f) }, (_ :: _ as args) ) when (field_name f) = "get_Item" -> - expr_s w ef; - write w "["; - let first = ref true in - List.iter (fun f -> - if !first then first := false else write w ", "; - expr_s w f - ) args; - write w "]" - | TCall({ eexpr = TField(ef,f) }, (_ :: _ :: _ as args) ) when (field_name f) = "set_Item" -> - expr_s w ef; - write w "["; - let args, value = match List.rev args with - | v :: args -> List.rev args, v - | _ -> die "" __LOC__ - in - let first = ref true in - List.iter (fun f -> - if !first then first := false else write w ", "; - expr_s w f - ) args; - write w "] = "; - expr_s w value - | TCall( ({ eexpr = TField(ef,f) } as e), [ev] ) when String.starts_with (field_name f) "add_" -> - let name = field_name f in - let propname = String.sub name 4 (String.length name - 4) in - if is_event (gen.greal_type ef.etype) propname then begin - expr_s w ef; - write w "."; - (get_write_field f) w propname; - write w " += "; - expr_s w ev - end else - do_call w e [ev] - | TCall( ({ eexpr = TField(ef,f) } as e), [ev] ) when String.starts_with (field_name f) "remove_" -> - let name = field_name f in - let propname = String.sub name 7 (String.length name - 7) in - if is_event (gen.greal_type ef.etype) propname then begin - expr_s w ef; - write w "."; - (get_write_field f) w propname; - write w " -= "; - expr_s w ev - end else - do_call w e [ev] - | TCall( ({ eexpr = TField(ef,f) } as e), [] ) when String.starts_with (field_name f) "get_" -> - let name = field_name f in - let propname = String.sub name 4 (String.length name - 4) in - if is_extern_prop (gen.greal_type ef.etype) propname then - if not was_in_value then - write w "{}" - else begin - expr_s w ef; - write w "."; - (get_write_field f) w propname - end - else - do_call w e [] - | TCall( ({ eexpr = TField(ef,f) } as e), [v] ) when String.starts_with (field_name f) "set_" -> - let name = field_name f in - let propname = String.sub name 4 (String.length name - 4) in - if is_extern_prop (gen.greal_type ef.etype) propname then begin - expr_s w ef; - write w "."; - (get_write_field f) w propname; - write w " = "; - expr_s w v - end else - do_call w e [v] - | TField (e, ((FStatic(_, cf) | FInstance(_, _, cf)) as f)) when Meta.has Meta.Native cf.cf_meta -> - let rec loop meta = match meta with - | (Meta.Native, [EConst (String(s,_)), _],_) :: _ -> - expr_s w e; write w "."; (get_write_field f) w s - | _ :: tl -> loop tl - | [] -> expr_s w e; write w "."; (get_write_field f) w (cf.cf_name) - in - loop cf.cf_meta - | TConst c -> - (match c with - | TInt i32 -> - write w (Int32.to_string i32); - (* these suffixes won't work because of the cast detector which will set each constant to its expected type *) - (*match real_type e.etype with - | TType( { t_path = (["haxe";"_Int64"], "NativeInt64") }, [] ) -> write w "L"; - | _ -> () - *) - | TFloat s -> - let s = Texpr.replace_separators s "" in - let len = String.length s in - let rec loop i prev_c = - if i >= len then begin - write w s; - if prev_c = '.' then write w "0" - end else begin - let c = String.unsafe_get s i in - if (c = 'e' || c = 'E') && prev_c = '.' then - let first = String.sub s 0 i in - let second = String.sub s i (len - i) in - write w first; - write w "0"; - write w second - else - loop (i + 1) c - end - in - loop 0 '#' - - (*match real_type e.etype with - | TType( { t_path = ([], "Single") }, [] ) -> write w "f" - | _ -> () - *) - | TString s -> - write w "\""; - write w (escape s); - write w "\"" - | TBool b -> write w (if b then "true" else "false") - | TNull when is_cs_basic_type e.etype || is_tparam e.etype -> - write w "default("; - write w (t_s e.etype); - write w ")" - | TNull -> write w "null" - | TThis -> write w "this" - | TSuper -> write w "base") - | TCast({ eexpr = TConst(TNull) }, _) -> - write w "default("; - write w (t_s e.etype); - write w ")" - | TIdent "__sbreak__" -> write w "break" - | TIdent "__undefined__" -> - write w (t_s (TInst(runtime_cl, List.map (fun _ -> t_dynamic) runtime_cl.cl_params))); - write w ".undefined"; - | TIdent "__typeof__" -> write w "typeof" - | TIdent "__sizeof__" -> write w "sizeof" - | TLocal var -> - write_id w var.v_name - | TField (_, (FEnum(e, ef) as f)) -> - let s = ef.ef_name in - print w "%s." ("global::" ^ module_s (TEnumDecl e)); (get_write_field f) w s - | TArray (e1, e2) -> - expr_s w e1; write w "["; expr_s w e2; write w "]" - | TBinop ((Ast.OpAssign as op), e1, e2) - | TBinop ((Ast.OpAssignOp _ as op), e1, e2) -> - expr_s w e1; write w ( " " ^ (Ast.s_binop op) ^ " " ); expr_s w e2 - (* hack to dodge #7034 *) - | TBinop (OpMod,_,e2) when (match (Texpr.skip e2).eexpr with TConst (TInt i32) -> i32 = Int32.zero | _ -> false) -> - write w ("System.Double.NaN") - | TBinop (op, e1, e2) -> - write w "( "; - expr_s w e1; write w ( " " ^ (Ast.s_binop op) ^ " " ); expr_s w e2; - write w " )" - | TField ({ eexpr = TTypeExpr mt }, s) -> - (match mt with - | TClassDecl { cl_path = (["haxe"], "Int64") } -> write w ("global::" ^ module_s mt) - | TClassDecl { cl_path = (["haxe"], "Int32") } -> write w ("global::" ^ module_s mt) - | TClassDecl c when (has_class_flag c CInterface) -> - write w ("global::" ^ module_s mt); - write w "__Statics_"; - | TClassDecl cl -> write w (t_s (TInst(cl, List.map (fun _ -> t_empty) cl.cl_params))) - | TEnumDecl en -> write w (t_s (TEnum(en, List.map (fun _ -> t_empty) en.e_params))) - | TTypeDecl td -> write w (t_s (gen.gfollow#run_f (TType(td, List.map (fun _ -> t_empty) td.t_params)))) - | TAbstractDecl a -> write w (t_s (TAbstract(a, List.map (fun _ -> t_empty) a.a_params))) - ); - write w "."; - (get_write_field s) w (field_name s) - | TField (e, s) when is_pointer gen e.etype -> - (* take off the extra cast if possible *) - let e = match e.eexpr with - | TCast(e1,_) when CastDetect.type_iseq gen e.etype e1.etype -> - e1 - | _ -> e - in - expr_s w e; write w "->"; (get_write_field s) w (field_name s) - | TField (e, s) -> - expr_s w e; write w "."; (get_write_field s) w (field_name s) - | TTypeExpr mt -> - (match change_md mt with - | TClassDecl { cl_path = (["haxe"], "Int64") } -> write w ("global::" ^ module_s mt) - | TClassDecl { cl_path = (["haxe"], "Int32") } -> write w ("global::" ^ module_s mt) - | TClassDecl cl -> write w (t_s (TInst(cl, List.map (fun _ -> t_empty) cl.cl_params))); - | TEnumDecl en -> write w (t_s (TEnum(en, List.map (fun _ -> t_empty) en.e_params))) - | TTypeDecl td -> write w (t_s (gen.gfollow#run_f (TType(td, List.map (fun _ -> t_empty) td.t_params)))) - | TAbstractDecl a -> write w (t_s (TAbstract(a, List.map (fun _ -> t_empty) a.a_params))) - ) - | TParenthesis e -> - write w "("; expr_s w e; write w ")" - | TMeta ((Meta.LoopLabel,[(EConst(Int (n, _)),_)],_), e) -> - (match e.eexpr with - | TFor _ | TWhile _ -> - expr_s w e; - print w "label%s: {}" n - | TBreak -> print w "goto label%s" n - | _ -> die "" __LOC__) - | TMeta (_,e) -> - expr_s w e - | TArrayDecl el - | TCall ({ eexpr = TIdent "__array__" }, el) - | TCall ({ eexpr = TField(_, FStatic({ cl_path = (["cs"],"NativeArray") }, { cf_name = "make" })) }, el) -> - let _, el = extract_tparams [] el in - print w "new %s" (t_s e.etype); - write w "{"; - ignore (List.fold_left (fun acc e -> - (if acc <> 0 then write w ", "); - expr_s w e; - acc + 1 - ) 0 el); - write w "}" - | TCall ({ eexpr = TIdent "__delegate__" }, [del]) -> - expr_s w del - | TCall ({ eexpr = TIdent "__is__" }, [ expr; { eexpr = TTypeExpr(md) } ] ) -> - write w "( "; - expr_s w expr; - write w " is "; - write w (md_s md); - write w " )" - | TCall ({ eexpr = TIdent "__as__" }, [ expr; { eexpr = TTypeExpr(md) } ] ) -> - write w "( "; - expr_s w expr; - write w " as "; - write w (md_s md); - write w " )" - | TCall ({ eexpr = TIdent "__as__" }, expr :: _ ) -> - write w "( "; - expr_s w expr; - write w " as "; - write w (t_s e.etype); - write w " )"; - | TCall({ eexpr = TField (_, FStatic ({ cl_path = ["cs"],"Syntax" }, { cf_name = meth })) }, args) -> - gen_syntax meth args e.epos - | TCall ({ eexpr = TIdent "__cs__" }, [ { eexpr = TConst(TString(s)) } ] ) -> - write w s - | TCall ({ eexpr = TIdent "__cs__" }, { eexpr = TConst(TString(s)) } :: tl ) -> - Codegen.interpolate_code gen.gcon s tl (write w) (expr_s w) e.epos - | TCall ({ eexpr = TIdent "__stackalloc__" }, [ e ] ) -> - write w "stackalloc byte["; - expr_s w e; - write w "]" - | TCall ({ eexpr = TIdent "__unsafe__" }, [ e ] ) -> - write w "unsafe "; - begin_block w; - expr_s w (mk_block e); - write w ";"; - end_block w - | TCall ({ eexpr = TIdent "__checked__" }, [ e ] ) -> - write w "checked"; - expr_s w (mk_block e) - | TCall ({ eexpr = TIdent "__lock__" }, [ eobj; eblock ] ) -> - write w "lock("; - expr_s w eobj; - write w ")"; - expr_s w (mk_block eblock) - | TCall ({ eexpr = TIdent "__fixed__" }, [ e ] ) -> - let fixeds = ref [] in - let rec loop = function - | ({ eexpr = TVar(v, Some(e) ) } as expr) :: tl when is_pointer gen v.v_type -> - let e = match get_ptr e with - | None -> e - | Some e -> e - in - fixeds := (v,e,expr) :: !fixeds; - loop tl; - | el when !fixeds <> [] -> - let rec loop fx acc = match fx with - | (v,e,expr) :: tl -> - write w "fixed("; - let vf = mk_temp "fixed" v.v_type in - expr_s w { expr with eexpr = TVar(vf, Some e) }; - write w ") "; - begin_block w; - expr_s w { expr with eexpr = TVar(v, Some (mk_local vf expr.epos)) }; - write w ";"; - newline w; - loop tl (acc + 1) - | [] -> acc - in - let nblocks = loop (List.rev !fixeds) 0 in - in_value := false; - expr_s w { e with eexpr = TBlock el }; - for _ = 1 to nblocks do - end_block w - done - | _ -> - trace (debug_expr e); - gen.gcon.error "Invalid 'fixed' keyword format" e.epos - in - (match e.eexpr with - | TBlock bl -> loop bl - | _ -> - trace "not block"; - trace (debug_expr e); - gen.gcon.error "Invalid 'fixed' keyword format" e.epos - ) - | TCall ({ eexpr = TIdent "__addressOf__" }, [ e ] ) -> - let e = ensure_local e "for addressOf" in - write w "&"; - expr_s w e - | TCall ({ eexpr = TIdent "__valueOf__" }, [ e ] ) -> - write w "*("; - expr_s w e; - write w ")" - (* operator overloading handling *) - | TCall({ eexpr = TField(ef, FInstance(cl,_,{ cf_name = "__get" })) }, [idx]) when not (is_hxgen (TClassDecl cl)) -> - expr_s w { e with eexpr = TArray(ef, idx) } - | TCall({ eexpr = TField(ef, FInstance(cl,_,{ cf_name = "__set" })) }, [idx; v]) when not (is_hxgen (TClassDecl cl)) -> - expr_s w { e with eexpr = TBinop(Ast.OpAssign, { e with eexpr = TArray(ef, idx) }, v) } - | TCall({ eexpr = TField(ef, FStatic(_,cf)) }, el) when PMap.mem cf.cf_name binops_names -> - let _, elr = extract_tparams [] el in - (match elr with - | [e1;e2] -> - expr_s w { e with eexpr = TBinop(PMap.find cf.cf_name binops_names, e1, e2) } - | _ -> do_call w e el) - | TCall({ eexpr = TField(ef, FStatic(_,cf)) }, el) when PMap.mem cf.cf_name unops_names -> - (match extract_tparams [] el with - | _, [e1] -> - expr_s w { e with eexpr = TUnop(PMap.find cf.cf_name unops_names, Ast.Prefix,e1) } - | _ -> do_call w e el) - | TCall (e, el) -> - do_call w e el - | TNew (({ cl_path = (["cs"], "NativeArray") } as cl), params, [ size ]) -> - let rec check_t_s t times = - match real_type t with - | TInst({ cl_path = (["cs"], "NativeArray") }, [param]) -> - (check_t_s param (times+1)) - | _ -> - print w "new %s[" (t_s (run_follow gen t)); - expr_s w size; - print w "]"; - let rec loop i = - if i <= 0 then () else (write w "[]"; loop (i-1)) - in - loop (times - 1) - in - check_t_s (TInst(cl, params)) 0 - | TNew ({ cl_path = ([], "String") } as cl, [], el) -> - write w "new "; - write w (t_s (TInst(cl, []))); - write w "("; - ignore (List.fold_left (fun acc e -> - (if acc <> 0 then write w ", "); - expr_s w e; - acc + 1 - ) 0 el); - write w ")" - | TNew ({ cl_kind = KTypeParameter _ } as cl, params, el) -> - print w "default(%s) /* This code should never be reached. It was produced by the use of @:generic on a new type parameter instance: %s */" (t_s (TInst(cl,params))) (path_param_s (TClassDecl cl) cl.cl_path params) - | TNew (cl, params, el) -> - write w "new "; - write w (path_param_s (TClassDecl cl) cl.cl_path params); - write w "("; - ignore (List.fold_left (fun acc e -> - (if acc <> 0 then write w ", "); - expr_s w e; - acc + 1 - ) 0 el); - write w ")" - | TUnop ((Ast.Increment as op), flag, e) - | TUnop ((Ast.Decrement as op), flag, e) -> - (match flag with - | Ast.Prefix -> write w ( " " ^ (Ast.s_unop op) ^ " " ); expr_s w e - | Ast.Postfix -> expr_s w e; write w (Ast.s_unop op)) - | TUnop (Spread, Prefix, e) -> - expr_s w e - | TUnop (op, flag, e) -> - (match flag with - | Ast.Prefix -> write w ( " " ^ (Ast.s_unop op) ^ " (" ); expr_s w e; write w ") " - | Ast.Postfix -> write w "("; expr_s w e; write w (") " ^ Ast.s_unop op)) - | TVar (var, eopt) -> - print w "%s " (t_s var.v_type); - write_id w var.v_name; - (match eopt with - | None -> - write w " = "; - expr_s w (null var.v_type e.epos) - | Some e -> - write w " = "; - expr_s w e - ) - | TBlock [e] when was_in_value -> - expr_s w e - | TBlock el -> - begin_block w; - List.iter (fun e -> - List.iter (fun e -> - line_directive w e.epos; - in_value := false; - expr_s w e; - (if has_semicolon e then write w ";"); - newline w - ) (extract_statements e) - ) el; - end_block w - | TIf (econd, e1, Some(eelse)) when was_in_value -> - let base = t_s e.etype in - write w "( "; - expr_s w (mk_paren econd); - write w " ? "; - if t_s e1.etype <> base then - expr_s w (mk_cast e.etype e1) - else - expr_s w (mk_paren e1); - - write w " : "; - if t_s eelse.etype <> base then - expr_s w (mk_cast e.etype eelse) - else - expr_s w (mk_paren eelse); - write w " )"; - | TIf (econd, e1, eelse) -> - write w "if "; - expr_s w (mk_paren econd); - write w " "; - in_value := false; - expr_s w (mk_block e1); - (match eelse with - | None -> () - | Some e -> - write w "else "; - in_value := false; - let e = match e.eexpr with - | TIf _ -> e - | TBlock [{eexpr = TIf _} as e] -> e - | _ -> mk_block e - in - expr_s w e - ) - | TWhile (econd, eblock, flag) -> - (match flag with - | Ast.NormalWhile -> - write w "while "; - expr_s w (mk_paren econd); - write w " "; - in_value := false; - expr_s w (mk_block eblock) - | Ast.DoWhile -> - write w "do "; - in_value := false; - expr_s w (mk_block eblock); - write w "while "; - in_value := true; - expr_s w (mk_paren econd); - ) - | TSwitch switch -> - write w "switch "; - expr_s w (mk_paren switch.switch_subject); - write w " "; - begin_block w; - List.iter (fun {case_patterns = el;case_expr = e} -> - List.iter (fun e -> - write w "case "; - in_value := true; - expr_s w e; - write w ":"; - newline w; - ) el; - in_value := false; - expr_s w (mk_block e); - newline w; - newline w - ) switch.switch_cases; - if is_some switch.switch_default then begin - write w "default:"; - newline w; - in_value := false; - expr_s w (get switch.switch_default); - newline w; - end; - end_block w - | TTry (tryexpr, ve_l) -> - write w "try "; - in_value := false; - expr_s w (mk_block tryexpr); - List.iter (fun (var, e) -> - print w "catch (%s %s)" (t_s var.v_type) (var.v_name); - in_value := false; - expr_s w (mk_block e); - newline w - ) ve_l - | TReturn eopt -> - write w "return"; - if is_some eopt then (write w " "; expr_s w (get eopt)) - | TBreak -> write w "break" - | TContinue -> write w "continue" - | TThrow { eexpr = TIdent "__rethrow__" } -> - write w "throw" - | TThrow { eexpr = TLocal(v) } when (has_var_flag v VCaught) -> - write w "throw"; - | TThrow e -> - write w "throw "; - expr_s w e - | TCast (e1,md_t) -> - ((*match gen.gfollow#run_f e.etype with - | TType({ t_path = ([], "UInt") }, []) -> - write w "( unchecked ((uint) "; - expr_s w e1; - write w ") )" - | _ ->*) - (* FIXME I'm ignoring module type *) - print w "((%s) (" (t_s e.etype); - expr_s w e1; - write w ") )" - ) - | TFor (_,_,content) -> - write w "[ for not supported "; - expr_s w content; - write w " ]"; - if !strict_mode then die "" __LOC__ - | TObjectDecl _ -> write w "[ obj decl not supported ]"; if !strict_mode then die "" __LOC__ - | TFunction _ -> write w "[ func decl not supported ]"; if !strict_mode then die "" __LOC__ - | TEnumParameter _ -> write w "[ enum parameter not supported ]"; if !strict_mode then die "" __LOC__ - | TEnumIndex _ -> write w "[ enum index not supported ]"; if !strict_mode then die "" __LOC__ - | TIdent s -> write w "[ ident not supported ]"; if !strict_mode then die "" __LOC__ - ) - and gen_syntax meth args pos = - match meth, args with - | "code", code :: args -> - let code, code_pos = - match code.eexpr with - | TConst (TString s) -> s, code.epos - | _ -> Error.abort "The `code` argument for cs.Syntax.code must be a string constant" code.epos - in - begin - let rec reveal_expr expr = - match expr.eexpr with - | TCast (e, _) | TMeta (_, e) -> reveal_expr e - | _ -> expr - in - let args = List.map - (fun arg -> - match (reveal_expr arg).eexpr with - | TIf _ | TBinop _ | TUnop _ -> { arg with eexpr = TParenthesis arg } - | _ -> arg - ) - args - in - Codegen.interpolate_code gen.gcon code args (write w) (expr_s w) code_pos - end - | "plainCode", [code] -> - let code = - match code.eexpr with - | TConst (TString s) -> s - | _ -> Error.abort "The `code` argument for cs.Syntax.plainCode must be a string constant" code.epos - in - write w (String.concat "\n" (ExtString.String.nsplit code "\r\n")) - | _ -> - Error.abort (Printf.sprintf "Unknown cs.Syntax method `%s` with %d arguments" meth (List.length args)) pos - and do_call w e el = - let params, el = extract_tparams [] el in - let params = List.rev params in - - expr_s w e; - - (match params with - | _ :: _ when not (erase_generics && field_is_hxgeneric e) -> - let md = match e.eexpr with - | TField(ef, _) -> - t_to_md (run_follow gen ef.etype) - | _ -> die "" __LOC__ - in - write w "<"; - ignore (List.fold_left (fun acc t -> - (if acc <> 0 then write w ", "); - write w (t_s t); - acc + 1 - ) 0 (change_param_type md params)); - write w ">" - | _ -> () - ); - - let rec loop acc elist tlist = - match elist, tlist with - | e :: etl, (_,_,t) :: ttl -> - (if acc <> 0 then write w ", "); - (match real_type t with - | TType({ t_path = (["cs"], "Ref") }, _) - | TAbstract ({ a_path = (["cs"], "Ref") },_) -> - let e = ensure_refout e "of type cs.Ref" in - write w "ref "; - expr_s w e - | TType({ t_path = (["cs"], "Out") }, _) - | TAbstract ({ a_path = (["cs"], "Out") },_) -> - let e = ensure_refout e "of type cs.Out" in - write w "out "; - expr_s w e - | _ -> - expr_s w e - ); - loop (acc + 1) etl ttl - | e :: etl, [] -> - (if acc <> 0 then write w ", "); - expr_s w e; - loop (acc + 1) etl [] - | _ -> () - in - write w "("; - let ft = match follow e.etype with - | TFun(args,_) -> args - | _ -> [] - in - - loop 0 el ft; - - write w ")" - in - expr_s w e - in - - let rec gen_fpart_attrib w = function - | EConst( Ident i ), _ -> - write w i - | EField( ef, f, _ ), _ -> - gen_fpart_attrib w ef; - write w "."; - write w f - | _, p -> - gen.gcon.error "Invalid expression inside @:meta metadata" p - in - - let rec gen_spart w = function - | EConst c, p -> (match c with - | Int (s, _) | Float (s, _) | Ident s -> - write w s - | String(s,_) -> - write w "\""; - write w (escape s); - write w "\"" - | _ -> gen.gcon.error "Invalid expression inside @:meta metadata" p) - | EField( ef, f, _ ), _ -> - gen_spart w ef; - write w "."; - write w f - | EBinop( Ast.OpAssign, (EConst (Ident s), _), e2 ), _ -> - write w s; - write w " = "; - gen_spart w e2 - | EArrayDecl( el ), _ -> - write w "new[] {"; - let fst = ref true in - List.iter (fun e -> - if !fst then fst := false else write w ", "; - gen_spart w e - ) el; - write w "}" - | ECall(fpart,args), _ -> - gen_fpart_attrib w fpart; - write w "("; - let fst = ref true in - List.iter (fun e -> - if !fst then fst := false else write w ", "; - gen_spart w e - ) args; - write w ")" - | _, p -> - gen.gcon.error "Invalid expression inside @:meta metadata" p - in - - let gen_assembly_attributes w metadata = - List.iter (function - | Meta.AssemblyMeta, [EConst(String(s,_)), _], _ -> - write w "[assembly:"; - write w s; - write w "]"; - newline w - | Meta.AssemblyMeta, [meta], _ -> - write w "[assembly:"; - gen_spart w meta; - write w "]"; - newline w - | _ -> () - ) metadata - in - - let gen_attributes w metadata = - List.iter (function - | Meta.Meta, [EConst(String(s,_)), _], _ -> - write w "["; - write w s; - write w "]"; - newline w - | Meta.Meta, [meta], _ -> - write w "["; - gen_spart w meta; - write w "]"; - newline w - | _ -> () - ) metadata - in - - let gen_nocompletion w metadata = - if Meta.has Meta.NoCompletion metadata then begin - write w "[global::System.ComponentModel.EditorBrowsable(global::System.ComponentModel.EditorBrowsableState.Never)]"; - newline w - end; - in - - let argt_s t = - let w = new_source_writer () in - let rec run t = - match t with - | TType (tdef,p) -> - gen_attributes w tdef.t_meta; - run (follow_once t) - | TMono r -> - (match r.tm_type with - | Some t -> run t - | _ -> () (* avoid infinite loop / should be the same in this context *)) - | TLazy f -> - run (lazy_type f) - | _ -> () - in - run t; - let ret = match run_follow gen t with - | TType ({ t_path = (["cs"], "Ref") }, [t]) - | TAbstract ({ a_path = (["cs"], "Ref") },[t]) -> "ref " ^ t_s t - | TType ({ t_path = (["cs"], "Out") }, [t]) - | TAbstract ({ a_path = (["cs"], "Out") },[t]) -> "out " ^ t_s t - | _ when ExtType.is_rest (Type.follow t) -> "params " ^ (t_s (Abstract.follow_with_abstracts t)) - | t -> t_s t - in - let c = contents w in - if c <> "" then - c ^ " " ^ ret - else - ret - in - - let get_string_params cl cl_params = - let hxgen = is_hxgen (TClassDecl cl) in - match cl_params with - | (_ :: _) when not (erase_generics && is_hxgeneric (TClassDecl cl)) -> - let combination_error c1 c2 = - gen.gcon.error ("The " ^ (get_constraint c1) ^ " constraint cannot be combined with the " ^ (get_constraint c2) ^ " constraint.") cl.cl_pos in - - let params = sprintf "<%s>" (String.concat ", " (List.map (fun tp -> snd tp.ttp_class.cl_path) cl_params)) in - let params_extends = - if hxgen || not (Meta.has (Meta.NativeGen) cl.cl_meta) then - [""] - else - List.fold_left (fun acc {ttp_name=name;ttp_type=t} -> - match t with - | TInst({cl_kind = KTypeParameter ttp} as c,_) when get_constraints ttp <> [] -> - (* base class should come before interface constraints *) - let base_class_constraints = ref [] in - let other_constraints = List.fold_left (fun acc t -> - match follow t with - (* string is implicitly sealed, maybe haxe should have it final as well *) - | TInst ({ cl_path=[],"String" }, []) -> - acc - - (* non-sealed class *) - | TInst (c,_) when not (has_class_flag c CFinal) && not (has_class_flag c CInterface) -> - base_class_constraints := (CsConstraint (t_s t)) :: !base_class_constraints; - acc; - - (* interface *) - | TInst (c, _) when (has_class_flag c CInterface) -> - (CsConstraint (t_s t)) :: acc - - (* cs constraints *) - (* See https://docs.microsoft.com/en-us/dotnet/csharp/programming-guide/generics/constraints-on-type-parameters *) - | TAbstract({ a_path = (_, c); a_module = { m_path = ([pack],"Constraints") } }, params) -> - (match pack, c with - | "haxe", "Constructible" -> - (match params with - (* Only for parameterless constructors *) - | [TFun ([],TAbstract({a_path=[],"Void"},_))] -> - if (List.memq CsStruct acc) then combination_error CsConstructible CsStruct; - if (List.memq CsUnmanaged acc) then combination_error CsUnmanaged CsConstructible; - CsConstructible :: acc; - | _ -> acc; - ) - | "cs", "CsStruct" -> - if (List.memq CsClass acc) then combination_error CsClass CsStruct; - if (List.memq CsConstructible acc) then combination_error CsConstructible CsStruct; - if (List.memq CsUnmanaged acc) then combination_error CsUnmanaged CsStruct; - CsStruct :: acc; - | "cs", "CsUnmanaged" -> - if (List.memq CsStruct acc) then combination_error CsUnmanaged CsStruct; - if (List.memq CsConstructible acc) then combination_error CsUnmanaged CsConstructible; - CsUnmanaged :: acc; - | "cs", "CsClass" -> - if (List.memq CsStruct acc) then combination_error CsClass CsStruct; - CsClass :: acc; - | _, _ -> acc; - ) - - (* skip anything other *) - | _ -> - acc - ) [] (get_constraints ttp ) in - - let s_constraints = (List.sort - (* C# expects some ordering for built-in constraints: *) - (fun c1 c2 -> match c1, c2 with - | a, b when a == b -> 0 - (* - "new()" type constraint should be last *) - | CsConstructible, _ -> 1 - | _, CsConstructible -> -1 - (* - "class", "struct" and "unmanaged" should be first *) - | CsClass, _ | CsStruct, _ | CsUnmanaged, _ -> -1 - | _, CsClass | _, CsStruct | _, CsUnmanaged -> 1 - | _, _ -> 0 - ) (!base_class_constraints @ other_constraints)) in - - if s_constraints <> [] then - (sprintf " where %s : %s" (snd c.cl_path) (String.concat ", " (List.map get_constraint s_constraints)) :: acc) - else - acc; - | _ -> acc - ) [] cl_params in - (params, String.concat " " params_extends) - | _ -> ("","") - in - - let gen_field_decl w visibility v_n modifiers t n = - let parts = ref [] in - if visibility <> "" then parts := visibility :: !parts; - if v_n <> "" then parts := v_n :: !parts; - if modifiers <> [] then parts := modifiers @ !parts; - if t <> "" then parts := t :: !parts; - parts := n :: !parts; - write w (String.concat " " (List.rev !parts)); - in - - let gen_event w is_static cl (event,t,custom,add,remove) = - let is_interface = (has_class_flag cl CInterface) in - let visibility = if is_interface then "" else "public" in - let visibility, modifiers = get_fun_modifiers event.cf_meta visibility ["event"] in - let v_n = if is_static then "static" else "" in - gen_field_decl w visibility v_n modifiers (t_s (run_follow gen t)) (change_class_field cl event.cf_name); - if custom && not is_interface then begin - write w " "; - begin_block w; - print w "add { _add_%s(value); }" event.cf_name; - newline w; - print w "remove { _remove_%s(value); }" event.cf_name; - newline w; - end_block w; - newline w; - end else - write w ";\n"; - newline w; - in - - let gen_prop w is_static cl is_final (prop,t,get,set) = - gen_attributes w prop.cf_meta; - let is_interface = (has_class_flag cl CInterface) in - let fn_is_final = function - | None -> true - | Some ({ cf_kind = Method mkind } as m) -> - (match mkind with | MethInline -> true | _ -> false) || (has_class_field_flag m CfFinal) - | _ -> die "" __LOC__ - in - let is_virtual = not (is_interface || is_final || (has_class_field_flag prop CfFinal) || fn_is_final get || fn_is_final set) in - - let fn_is_override = function - | Some cf -> has_class_field_flag cf CfOverride - | None -> false - in - let is_override = fn_is_override get || fn_is_override set in - let visibility = if is_interface then "" else "public" in - let visibility, modifiers = get_fun_modifiers prop.cf_meta visibility [] in - let v_n = if is_static then "static" else if is_override && not is_interface then "override" else if is_virtual then "virtual" else "" in - gen_nocompletion w prop.cf_meta; - - gen_field_decl w visibility v_n modifiers (t_s (run_follow gen t)) (change_class_field cl prop.cf_name); - - let check cf = match cf with - | Some ({ cf_overloads = o :: _ } as cf) -> - gen.gcon.error "Property functions with more than one overload is currently unsupported" cf.cf_pos; - gen.gcon.error "Property functions with more than one overload is currently unsupported" o.cf_pos - | _ -> () - in - check get; - check set; - - write w " "; - if is_interface then begin - write w "{ "; - let s = ref "" in - (match prop.cf_kind with Var { v_read = AccCall } -> write w "get;"; s := " "; | _ -> ()); - (match prop.cf_kind with Var { v_write = AccCall } -> print w "%sset;" !s | _ -> ()); - write w " }"; - newline w; - end else begin - begin_block w; - (match get with - | Some cf -> - print w "get { return _get_%s(); }" prop.cf_name; - newline w; - cf.cf_meta <- (Meta.Custom "?prop_impl", [], null_pos) :: cf.cf_meta; - | None -> ()); - (match set with - | Some cf -> - print w "set { _set_%s(value); }" prop.cf_name; - newline w; - cf.cf_meta <- (Meta.Custom "?prop_impl", [], null_pos) :: cf.cf_meta; - | None -> ()); - end_block w; - newline w; - newline w; - end; - in - - let needs_unchecked e = - let rec loop e = match e.eexpr with - (* a non-zero integer constant means that we want unchecked context *) - | TConst (TInt i) when i <> Int32.zero -> - raise Exit - - (* don't recurse into explicit checked blocks *) - | TCall ({ eexpr = TIdent "__checked__" }, _) -> - () - - (* skip reflection field hashes as they are safe *) - | TNew ({ cl_path = (["haxe"; "lang"],"DynamicObject") }, [], [_; e1; _; e2]) -> - loop e1; - loop e2 - | TNew ({ cl_path = (["haxe"; "lang"],"Closure") }, [], [eo; _; _]) -> - loop eo - | TCall ({ eexpr = TField (_, FStatic ({ cl_path = ["haxe"; "lang"],"Runtime" }, - { cf_name = "getField" | "setField" | "getField_f" | "setField_f" | "callField" })) }, - eo :: _ :: _ :: rest) -> - loop eo; - List.iter loop rest - - | _ -> - Type.iter loop e - in - try (loop e; false) with Exit -> true - in - - let rec gen_class_field w ?(is_overload=false) is_static cl is_final cf = - gen_attributes w cf.cf_meta; - let is_interface = (has_class_flag cl CInterface) in - let name, is_new, is_explicit_iface = match cf.cf_name with - | "new" -> cf.cf_name, true, false - | name when String.contains name '.' -> - let fn_name, path = parse_explicit_iface name in - (s_type_path path) ^ "." ^ fn_name, false, true - | name -> try - let binop = PMap.find name binops_names in - "operator " ^ s_binop binop, false, false - with | Not_found -> try - let unop = PMap.find name unops_names in - "operator " ^ s_unop unop, false, false - with | Not_found -> - if Meta.has (Meta.Custom "?prop_impl") cf.cf_meta || Meta.has (Meta.Custom ":cs_event_impl") cf.cf_meta then - "_" ^ name, false, false - else - name, false, false - in - let rec loop_static cl = - match is_static, cl.cl_super with - | false, _ -> [] - | true, None -> [] - | true, Some(cl,_) -> - (try - let cf2 = PMap.find cf.cf_name cl.cl_statics in - CastDetect.type_eq gen EqStrict cf.cf_type cf2.cf_type; - ["new"] - with - | Not_found | Unify_error _ -> - loop_static cl - ) - in - let modf = loop_static cl in - - (match cf.cf_kind with - | Var _ - | Method (MethDynamic) when Type.is_physical_field cf -> - (if is_overload || List.exists (fun cf -> cf.cf_expr <> None) cf.cf_overloads then - gen.gcon.error "Only normal (non-dynamic) methods can be overloaded" cf.cf_pos); - if not is_interface then begin - let access, modifiers = get_fun_modifiers cf.cf_meta "public" [] in - let modifiers = modifiers @ modf in - gen_nocompletion w cf.cf_meta; - gen_field_decl w access (if is_static then "static" else "") modifiers (t_s (run_follow gen cf.cf_type)) (change_class_field cl name); - (match cf.cf_expr with - | Some e -> - write w " = "; - expr_s true w e; - write w ";" - | None when (Meta.has Meta.Property cf.cf_meta) -> - write w " { get; set; }"; - | None -> - write w ";" - ); - end (* TODO see how (get,set) variable handle when they are interfaces *) - | Method _ when not (Type.is_physical_field cf) || (match cl.cl_kind, cf.cf_expr with | KAbstractImpl _, None -> true | _ -> false) -> - List.iter (fun cf -> if (has_class_flag cl CInterface) || cf.cf_expr <> None then - gen_class_field w ~is_overload:true is_static cl (has_class_field_flag cf CfFinal) cf - ) cf.cf_overloads - | Var _ | Method MethDynamic -> () - | Method _ when is_new && Meta.has Meta.Struct cl.cl_meta && fst (get_fun cf.cf_type) = [] -> - (* make sure that the method is empty *) - let rec check_empty expr = match expr.eexpr with - | TBlock(bl) -> bl = [] || List.for_all check_empty bl - | TMeta(_,e) -> check_empty e - | TParenthesis(e) -> check_empty e - | TConst(TNull) -> true - | TFunction(tf) -> check_empty tf.tf_expr - | _ -> false - in - (match cf.cf_expr with - | Some e -> - if not (check_empty e) then - gen.gcon.error "The body of a zero argument constructor of a struct should be empty" e.epos - | _ -> ()); - List.iter (fun cf -> - if (has_class_flag cl CInterface) || cf.cf_expr <> None then - gen_class_field w ~is_overload:true is_static cl (has_class_field_flag cf CfFinal) cf - ) cf.cf_overloads; - | Method mkind -> - let overloads = - match cf.cf_overloads with - | [] when is_overload -> [] - | [] when has_meta Meta.NativeGen cl.cl_meta -> - get_overloads_for_optional_args gen cl cf is_static - | overloads -> overloads - in - List.iter (fun cf -> - if (has_class_flag cl CInterface) || (has_class_flag cl CAbstract) || cf.cf_expr <> None then - gen_class_field w ~is_overload:true is_static cl (has_class_field_flag cf CfFinal) cf - ) overloads; - let is_virtual = not is_final && match mkind with | MethInline -> false | _ when not is_new -> true | _ -> false in - let is_virtual = if not is_virtual || (has_class_field_flag cf CfFinal) then false else is_virtual in - let is_override = has_class_field_flag cf CfOverride in - let is_override = is_override || match cf.cf_name, follow cf.cf_type with - | "Equals", TFun([_,_,targ], tret) -> - (match follow targ, follow tret with - | TDynamic _, TAbstract({ a_path = ([], "Bool") }, []) -> true - | _ -> false) - | "GetHashCode", TFun([],_) -> true - | _ -> false - in - let is_override = if Meta.has (Meta.Custom "?prop_impl") cf.cf_meta then false else is_override in - - let is_abstract = has_class_field_flag cf CfAbstract in - let is_virtual = is_virtual && not (has_class_flag cl CFinal) && not (is_interface) && not is_abstract in - let visibility = if is_interface then "" else "public" in - - let visibility, modifiers = get_fun_modifiers cf.cf_meta visibility [] in - let modifiers = modifiers @ modf in - let modifiers = if is_abstract then "abstract" :: modifiers else modifiers in - let visibility, is_virtual = if is_explicit_iface then "",false else if visibility = "private" then "private",false else visibility, is_virtual in - let v_n = if is_static then "static" else if is_override && not is_interface then "override" else if is_virtual then "virtual" else "" in - let cf_type = if is_override && not is_overload && not (has_class_field_flag cf CfOverload) then match field_access gen (TInst(cl, extract_param_types cl.cl_params)) cf.cf_name with | FClassField(_,_,_,_,_,actual_t,_) -> actual_t | _ -> die "" __LOC__ else cf.cf_type in - let ret_type, args = match follow cf_type with | TFun (strbtl, t) -> (t, strbtl) | _ -> die "" __LOC__ in - gen_nocompletion w cf.cf_meta; - - (* public static void funcName *) - gen_field_decl w visibility v_n modifiers (if not is_new then (rett_s (run_follow gen ret_type)) else "") (change_class_field cl name); - - let params, params_ext = get_string_params cl cf.cf_params in - (* (string arg1, object arg2) with T : object *) - (match cf.cf_expr with - | Some { eexpr = TFunction tf } -> - print w "%s(%s)%s" (params) (String.concat ", " (List.map2 (fun (var, _) (_,_,t) -> sprintf "%s %s" (argt_s t) (change_id var.v_name)) tf.tf_args args)) (params_ext) - | _ -> - print w "%s(%s)%s" (params) (String.concat ", " (List.map (fun (name, _, t) -> sprintf "%s %s" (argt_s t) (change_id name)) args)) (params_ext) - ); - if is_interface || is_abstract then - write w ";" - else begin - write w " "; - let rec loop meta = - match meta with - | [] -> - let expr = match cf.cf_expr with - | None -> mk (TBlock([])) t_dynamic null_pos - | Some s -> - match s.eexpr with - | TFunction tf -> - mk_block (tf.tf_expr) - | _ -> die "" __LOC__ (* FIXME *) - in - - let write_method_expr e = - match e.eexpr with - | TBlock [] -> - begin_block w; - end_block w - | TBlock _ -> - let unchecked = needs_unchecked e in - if unchecked then (begin_block w; write w "unchecked "); - let t = Timer.timer ["expression to string"] in - expr_s false w e; - t(); - line_reset_directive w; - if unchecked then end_block w - | _ -> - die "" __LOC__ - in - - (if is_new then begin - let rec get_super_call el = - match el with - | ( { eexpr = TCall( { eexpr = TConst(TSuper) }, _) } as call) :: rest -> - Some call, rest - | ( { eexpr = TBlock(bl) } as block ) :: rest -> - let ret, mapped = get_super_call bl in - ret, ( { block with eexpr = TBlock(mapped) } :: rest ) - | _ -> - None, el - in - match expr.eexpr with - (* auto-generated ctor overloading for optional args (see get_overloads_for_optional_args) *) - | TBlock([{ eexpr = TCall ({ eexpr = TConst TThis }, args) } as this_call]) -> - write w ": "; - let t = Timer.timer ["expression to string"] in - expr_s false w this_call; - write w " "; - t(); - write w "{}" - | TBlock(bl) -> - let super_call, rest = get_super_call bl in - (match super_call with - | None -> () - | Some sc -> - write w ": "; - let t = Timer.timer ["expression to string"] in - expr_s false w sc; - write w " "; - t() - ); - write_method_expr { expr with eexpr = TBlock(rest) } - | _ -> die "" __LOC__ - end else - write_method_expr expr - ) - | (Meta.FunctionCode, [Ast.EConst (Ast.String(contents,_)),_],_) :: tl -> - begin_block w; - write w contents; - end_block w - | _ :: tl -> loop tl - in - loop cf.cf_meta - - end); - newline w; - newline w; - in - - let check_special_behaviors w cl = match cl.cl_kind with - | KAbstractImpl _ -> () - | _ -> - (* get/set pairs *) - let pairs = ref PMap.empty in - (try - let get = PMap.find "__get" cl.cl_fields in - List.iter (fun cf -> - let args,ret = get_fun cf.cf_type in - match args with - | [_,_,idx] -> pairs := PMap.add (t_s idx) ( t_s ret, Some cf, None ) !pairs - | _ -> gen.gwarning WGenerator "The __get function must have exactly one argument (the index)" cf.cf_pos - ) (get :: get.cf_overloads) - with | Not_found -> ()); - (try - let set = PMap.find "__set" cl.cl_fields in - List.iter (fun cf -> - let args, ret = get_fun cf.cf_type in - match args with - | [_,_,idx; _,_,v] -> (try - let vt, g, _ = PMap.find (t_s idx) !pairs in - let tvt = t_s v in - if vt <> tvt then gen.gwarning WGenerator "The __get function of same index has a different type from this __set function" cf.cf_pos; - pairs := PMap.add (t_s idx) (vt, g, Some cf) !pairs - with | Not_found -> - pairs := PMap.add (t_s idx) (t_s v, None, Some cf) !pairs) - | _ -> - gen.gwarning WGenerator "The __set function must have exactly two arguments (index, value)" cf.cf_pos - ) (set :: set.cf_overloads) - with | Not_found -> ()); - PMap.iter (fun idx (v, get, set) -> - print w "public %s this[%s index]" v idx; - begin_block w; - (match get with - | None -> () - | Some _ -> - write w "get"; - begin_block w; - write w "return this.__get(index);"; - end_block w); - (match set with - | None -> () - | Some _ -> - write w "set"; - begin_block w; - write w "this.__set(index,value);"; - end_block w); - end_block w) !pairs; - (if not (PMap.is_empty !pairs) then try - let get = PMap.find "__get" cl.cl_fields in - let idx_t, v_t = match follow get.cf_type with - | TFun([_,_,arg_t],ret_t) -> - t_s (run_follow gen arg_t), t_s (run_follow gen ret_t) - | _ -> gen.gcon.error "The __get function must be a function with one argument. " get.cf_pos; die "" __LOC__ - in - List.iter (fun (cl,args) -> - match cl.cl_array_access with - | None -> () - | Some t -> - let changed_t = apply_params cl.cl_params (List.map (fun _ -> t_dynamic) cl.cl_params) t in - let t_as_s = t_s (run_follow gen changed_t) in - print w "%s %s.this[int key]" t_as_s (t_s (TInst(cl, args))); - begin_block w; - write w "get"; - begin_block w; - print w "return ((%s) this.__get(key));" t_as_s; - end_block w; - write w "set"; - begin_block w; - print w "this.__set(key, (%s) value);" v_t; - end_block w; - end_block w; - newline w; - newline w - ) cl.cl_implements - with | Not_found -> ()); - if (has_class_flag cl CInterface) && is_hxgen (TClassDecl cl) && is_some cl.cl_array_access then begin - let changed_t = apply_params cl.cl_params (List.map (fun _ -> t_dynamic) cl.cl_params) (get cl.cl_array_access) in - print w "%s this[int key]" (t_s (run_follow gen changed_t)); - begin_block w; - write w "get;"; - newline w; - write w "set;"; - newline w; - end_block w; - newline w; - newline w - end; - (try - if (has_class_flag cl CInterface) then raise Not_found; - let cf = PMap.find "toString" cl.cl_fields in - (if has_class_field_flag cf CfOverride then raise Not_found); - (match cf.cf_type with - | TFun([], ret) -> - (match real_type ret with - | TInst( { cl_path = ([], "String") }, []) -> - write w "public override string ToString()"; - begin_block w; - write w "return this.toString();"; - end_block w; - newline w; - newline w - | _ -> - gen.gcon.error "A toString() function should return a String!" cf.cf_pos - ) - | _ -> () - ) - with | Not_found -> ()); - (try - if (has_class_flag cl CInterface) then raise Not_found; - let cf = PMap.find "finalize" cl.cl_fields in - (if has_class_field_flag cf CfOverride then raise Not_found); - (match cf.cf_type with - | TFun([], ret) -> - (match real_type ret with - | TAbstract( { a_path = ([], "Void") }, []) -> - write w "~"; - write w (snd cl.cl_path); - write w "()"; - begin_block w; - write w "this.finalize();"; - end_block w; - newline w; - newline w - | _ -> - gen.gcon.error "A finalize() function should be Void->Void!" cf.cf_pos - ) - | _ -> () - ) - with | Not_found -> ()); - (* properties *) - let handle_prop static f = - match f.cf_kind with - | Method _ -> () - | Var v when Type.is_physical_field f -> () - | Var v -> - let prop acc = match acc with - | AccNo | AccNever | AccCall -> true - | _ -> false - in - if prop v.v_read && prop v.v_write && (v.v_read = AccCall || v.v_write = AccCall) then begin - let this = if static then - make_static_this cl f.cf_pos - else - { eexpr = TConst TThis; etype = TInst(cl,extract_param_types cl.cl_params); epos = f.cf_pos } - in - print w "public %s%s %s" (if static then "static " else "") (t_s f.cf_type) (Dotnet.netname_to_hx f.cf_name); - begin_block w; - (match v.v_read with - | AccCall -> - write w "get"; - begin_block w; - write w "return "; - expr_s true w this; - print w ".get_%s();" f.cf_name; - end_block w - | _ -> ()); - (match v.v_write with - | AccCall -> - write w "set"; - begin_block w; - expr_s false w this; - print w ".set_%s(value);" f.cf_name; - end_block w - | _ -> ()); - end_block w; - end - in - if Meta.has Meta.BridgeProperties cl.cl_meta then begin - List.iter (handle_prop true) cl.cl_ordered_statics; - List.iter (handle_prop false) cl.cl_ordered_fields; - end - in - - let gen_class w cl is_first_type = - if (is_first_type == false) then begin - if Meta.has Meta.AssemblyStrict cl.cl_meta then - gen.gcon.error "@:cs.assemblyStrict can only be used on the first class of a module" cl.cl_pos - else if Meta.has Meta.AssemblyMeta cl.cl_meta then - gen.gcon.error "@:cs.assemblyMeta can only be used on the first class of a module" cl.cl_pos; - end; - - write w "#pragma warning disable 109, 114, 219, 429, 168, 162"; - newline w; - let should_close = match change_ns (TClassDecl cl) (fst (cl.cl_path)) with - | [] -> - (* Should the assembly annotations be added to the class in this case? *) - - if Meta.has Meta.AssemblyStrict cl.cl_meta then - gen.gcon.error "@:cs.assemblyStrict cannot be used on top level modules" cl.cl_pos - else if Meta.has Meta.AssemblyMeta cl.cl_meta then - gen.gcon.error "@:cs.assemblyMeta cannot be used on top level modules" cl.cl_pos; - - false - | ns -> - gen_assembly_attributes w cl.cl_meta; - print w "namespace %s " (String.concat "." ns); - begin_block w; - true - in - - (try - let _,m,_ = Meta.get (Meta.Custom "generic_iface") cl.cl_meta in - let rec loop i acc = - if i == 0 then - acc - else - "object" :: (loop (pred i) acc) - in - let tparams = loop (match m with [(EConst(Int (s, _)),_)] -> int_of_string s | _ -> die "" __LOC__) [] in - cl.cl_meta <- (Meta.Meta, [ - EConst(String("global::haxe.lang.GenericInterface(typeof(global::" ^ module_s (TClassDecl cl) ^ "<" ^ String.concat ", " tparams ^ ">))",SDoubleQuotes) ), cl.cl_pos - ], cl.cl_pos) :: cl.cl_meta - with Not_found -> - ()); - - gen_attributes w cl.cl_meta; - - let main_expr = - match gen.gentry_point with - | Some (_,({ cl_path = (_,"Main") } as cl_main),expr) when cl == cl_main && not (has_class_flag cl CInterface) -> - (* - for cases where the main class is called Main, there will be a problem with creating the entry point there. - In this special case, a special entry point class will be created - *) - write w "public class EntryPoint__Main "; - begin_block w; - write w "public static void Main() "; - begin_block w; - (if Hashtbl.mem gen.gtypes (["cs"], "Boot") then write w "global::cs.Boot.init();"; newline w); - expr_s false w expr; - write w ";"; - end_block w; - end_block w; - newline w; - None - | Some (_, cl_main,expr) when cl == cl_main && not (has_class_flag cl CInterface) -> Some expr - | _ -> None - in - - let clt, access, modifiers = get_class_modifiers cl.cl_meta (if (has_class_flag cl CInterface) then "interface" else "class") "public" [] in - let modifiers = if is_module_fields_class cl then "static" :: modifiers else if (has_class_flag cl CFinal) then "sealed" :: modifiers else modifiers in - let is_final = clt = "struct" || (has_class_flag cl CFinal) in - - let modifiers = [access] @ modifiers in - let is_abstract = has_class_flag cl CAbstract in - let modifiers = if is_abstract then "abstract" :: modifiers else modifiers in - print w "%s %s %s" (String.concat " " modifiers) clt (change_clname (snd cl.cl_path)); - (* type parameters *) - let params, params_ext = get_string_params cl cl.cl_params in - let extends_implements = (match cl.cl_super with | None -> [] | Some (cl,p) -> [path_param_s (TClassDecl cl) cl.cl_path p]) @ (List.map (fun (cl,p) -> path_param_s (TClassDecl cl) cl.cl_path p) cl.cl_implements) in - (match extends_implements with - | [] -> print w "%s%s " params params_ext - | _ -> print w "%s : %s%s " params (String.concat ", " extends_implements) params_ext); - (* class head ok: *) - (* public class Test : X, Y, Z where A : Y *) - begin_block w; - newline w; - (* our constructor is expected to be a normal "new" function * - if !strict_mode && is_some cl.cl_constructor then die "" __LOC__;*) - - let rec loop meta = - match meta with - | [] -> () - | (Meta.ClassCode, [Ast.EConst (Ast.String(contents,_)),_],_) :: tl -> - write w contents - | _ :: tl -> loop tl - in - loop cl.cl_meta; - - Option.may (fun expr -> - write w "public static void Main()"; - begin_block w; - (if Hashtbl.mem gen.gtypes (["cs"], "Boot") then write w "global::cs.Boot.init();"; newline w); - expr_s false w expr; - write w ";"; - end_block w - ) main_expr; - - (match TClass.get_cl_init cl with - | None -> () - | Some init -> - let needs_block,write_expr = - let unchecked = needs_unchecked init in - if cl.cl_params = [] then - unchecked, (fun() -> - if unchecked then write w "unchecked"; - expr_s false w (mk_block init) - ) - else begin - write w "static bool __hx_init_called = false;"; - newline w; - true, (fun() -> - let flag = (t_s (TInst(cl, List.map (fun _ -> t_empty) cl.cl_params))) ^ ".__hx_init_called" in - write w ("if(" ^ flag ^ ") return;"); - newline w; - write w (flag ^ " = true;"); - newline w; - if unchecked then write w "unchecked"; - expr_s false w (mk_block init); - newline w - ) - end - in - print w "static %s() " (snd cl.cl_path); - if needs_block then begin - begin_block w; - write_expr(); - end_block w; - end else - write_expr(); - line_reset_directive w; - newline w; - newline w - ); - - (* collect properties and events *) - let partition cf cflist = - let events, props, nonprops = ref [], ref [], ref [] in - - List.iter (fun v -> match v.cf_kind with - | Var { v_read = AccCall } | Var { v_write = AccCall } when not (Type.is_physical_field v) && Meta.has Meta.Property v.cf_meta -> - props := (v.cf_name, ref (v, v.cf_type, None, None)) :: !props; - | Var { v_read = AccNormal; v_write = AccNormal } when Meta.has Meta.Event v.cf_meta -> - events := (v.cf_name, ref (v, v.cf_type, false, None, None)) :: !events; - | _ -> - nonprops := v :: !nonprops; - ) cflist; - - let events, nonprops = !events, !nonprops in - - let t = TInst(cl, extract_param_types cl.cl_params) in - let find_prop name = try - List.assoc name !props - with | Not_found -> match field_access gen t name with - | FClassField (_,_,decl,v,_,t,_) when is_extern_prop (TInst(cl,extract_param_types cl.cl_params)) name -> - let ret = ref (v,t,None,None) in - props := (name, ret) :: !props; - ret - | _ -> raise Not_found - in - - let find_event name = List.assoc name events in - - let is_empty_function cf = match cf.cf_expr with - | Some {eexpr = TFunction { tf_expr = {eexpr = TBlock []}}} -> true - | _ -> false - in - - let interf = (has_class_flag cl CInterface) in - (* get all functions that are getters/setters *) - let nonprops = List.filter (function - | cf when String.starts_with cf.cf_name "get_" -> (try - (* find the property *) - let prop = find_prop (String.sub cf.cf_name 4 (String.length cf.cf_name - 4)) in - let v, t, get, set = !prop in - assert (get = None); - prop := (v,t,Some cf,set); - not interf - with | Not_found -> true) - | cf when String.starts_with cf.cf_name "set_" -> (try - (* find the property *) - let prop = find_prop (String.sub cf.cf_name 4 (String.length cf.cf_name - 4)) in - let v, t, get, set = !prop in - assert (set = None); - prop := (v,t,get,Some cf); - not interf - with | Not_found -> true) - | cf when String.starts_with cf.cf_name "add_" -> (try - let event = find_event (String.sub cf.cf_name 4 (String.length cf.cf_name - 4)) in - let v, t, _, add, remove = !event in - assert (add = None); - let custom = not (is_empty_function cf) in - event := (v, t, custom, Some cf, remove); - false - with | Not_found -> true) - | cf when String.starts_with cf.cf_name "remove_" -> (try - let event = find_event (String.sub cf.cf_name 7 (String.length cf.cf_name - 7)) in - let v, t, _, add, remove = !event in - assert (remove = None); - let custom = not (is_empty_function cf) in - event := (v, t, custom, add, Some cf); - false - with | Not_found -> true) - | _ -> true - ) nonprops in - - let nonprops = ref nonprops in - List.iter (fun (n,r) -> - let ev, t, custom, add, remove = !r in - match add, remove with - | Some add, Some remove -> - if custom && not (has_class_flag cl CInterface) then - nonprops := add :: remove :: !nonprops - | _ -> die "" __LOC__ (* shouldn't happen because Filters.check_cs_events makes sure methods are present *) - ) events; - - let evts = List.map (fun(_,v) -> !v) events in - let ret = List.map (fun (_,v) -> !v) !props in - let ret = List.filter (function | (_,_,None,None) -> false | _ -> true) ret in - evts, ret, List.rev !nonprops - in - - let fevents, fprops, fnonprops = partition cl cl.cl_ordered_fields in - let sevents, sprops, snonprops = partition cl cl.cl_ordered_statics in - (if is_some cl.cl_constructor then gen_class_field w false cl is_final (get cl.cl_constructor)); - if not (has_class_flag cl CInterface) then begin - (* we don't want to generate properties for abstract implementation classes, because they don't have object to work with *) - List.iter (gen_event w true cl) sevents; - if (match cl.cl_kind with KAbstractImpl _ -> false | _ -> true) then List.iter (gen_prop w true cl is_final) sprops; - List.iter (gen_class_field w true cl is_final) snonprops - end; - List.iter (gen_event w false cl) fevents; - List.iter (gen_prop w false cl is_final) fprops; - List.iter (gen_class_field w false cl is_final) fnonprops; - check_special_behaviors w cl; - end_block w; - if (has_class_flag cl CInterface) && cl.cl_ordered_statics <> [] then begin - print w "public class %s__Statics_" (snd cl.cl_path); - begin_block w; - remove_class_flag cl CInterface; - List.iter (gen_class_field w true cl is_final) cl.cl_ordered_statics; - add_class_flag cl CInterface; - end_block w - end; - if should_close then end_block w - in - - - let gen_enum w e = - let should_close = match change_ns (TEnumDecl e) (fst e.e_path) with - | [] -> false - | ns -> - print w "namespace %s" (String.concat "." ns); - begin_block w; - true - in - gen_attributes w e.e_meta; - - print w "public enum %s" (change_clname (snd e.e_path)); - begin_block w; - write w (String.concat ", " (List.map (change_id) e.e_names)); - end_block w; - - if should_close then end_block w - in - - let module_type_gen w md_tp is_first_type = - let file_start = len w = 0 in - let requires_root = no_root && file_start in - if file_start then - Codegen.map_source_header gen.gcon (fun s -> print w "// %s\n" s); - reset_temps(); - match md_tp with - | TClassDecl cl -> - if not (has_class_flag cl CExtern) then begin - (if requires_root then write w "using haxe.root;\n"; newline w;); - - (if (Meta.has Meta.CsUsing cl.cl_meta) then - match (Meta.get Meta.CsUsing cl.cl_meta) with - | _,_,p when not !is_first_type -> - gen.gcon.error "@:cs.using can only be used on the first type of a module" p - | _,[],p -> - gen.gcon.error "One or several string constants expected" p - | _,e,_ -> - (List.iter (fun e -> - match e with - | (EConst(String(s,_))),_ -> write w (Printf.sprintf "using %s;\n" s) - | _,p -> gen.gcon.error "One or several string constants expected" p - ) e); - newline w - ); - - gen_class w cl !is_first_type; - is_first_type := false; - newline w; - newline w - end; - (not (has_class_flag cl CExtern)) - | TEnumDecl e -> - if not e.e_extern && not (Meta.has Meta.Class e.e_meta) then begin - (if requires_root then write w "using haxe.root;\n"; newline w;); - gen_enum w e; - is_first_type := false; - newline w; - newline w - end; - (not e.e_extern) - | TAbstractDecl _ - | TTypeDecl _ -> - false - in - - (* generate source code *) - init_ctx gen; - - Hashtbl.add gen.gspecial_vars "__rethrow__" true; - Hashtbl.add gen.gspecial_vars "__typeof__" true; - Hashtbl.add gen.gspecial_vars "__is__" true; - Hashtbl.add gen.gspecial_vars "__as__" true; - Hashtbl.add gen.gspecial_vars "__cs__" true; - - Hashtbl.add gen.gspecial_vars "__checked__" true; - Hashtbl.add gen.gspecial_vars "__lock__" true; - Hashtbl.add gen.gspecial_vars "__fixed__" true; - Hashtbl.add gen.gspecial_vars "__unsafe__" true; - Hashtbl.add gen.gspecial_vars "__addressOf__" true; - Hashtbl.add gen.gspecial_vars "__valueOf__" true; - Hashtbl.add gen.gspecial_vars "__sizeof__" true; - Hashtbl.add gen.gspecial_vars "__stackalloc__" true; - - Hashtbl.add gen.gspecial_vars "__delegate__" true; - Hashtbl.add gen.gspecial_vars "__array__" true; - Hashtbl.add gen.gspecial_vars "__ptr__" true; - - Hashtbl.add gen.gsupported_conversions (["haxe"; "lang"], "Null") (fun t1 t2 -> true); - let last_needs_box = gen.gneeds_box in - gen.gneeds_box <- (fun t -> match (gen.greal_type t) with - | TAbstract( ( { a_path = ["cs"], "Pointer" }, _ ) ) - | TInst( { cl_path = ["cs"], "Pointer" }, _ ) - | TInst( { cl_path = (["haxe"; "lang"], "Null") }, _ ) -> true - | _ -> last_needs_box t); - - gen.greal_type <- real_type; - gen.greal_type_param <- change_param_type; - - (* before running the filters, follow all possible types *) - (* this is needed so our module transformations don't break some core features *) - (* like multitype selection *) - let run_follow_gen = run_follow gen in - let rec type_map e = Type.map_expr_type (fun e->type_map e) (run_follow_gen) (fun tvar-> tvar.v_type <- (run_follow_gen tvar.v_type); tvar) e in - 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 @ (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; - - (* add @:skipReflection to @:event vars *) - match cf.cf_kind with - | Var _ when (Meta.has Meta.Event cf.cf_meta) && not (Meta.has Meta.SkipReflection cf.cf_meta) -> - cf.cf_meta <- (Meta.SkipReflection, [], null_pos) :: cf.cf_meta; - | _ -> () - - ) 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_super <- Option.map super_map cl.cl_super; - cl.cl_implements <- List.map super_map cl.cl_implements - | _ -> () - ) gen.gtypes_list; - - let mk_tp t pos = { eexpr = TIdent "$type_param"; etype = t; epos = pos } in - gen.gparam_func_call <- (fun ecall efield params elist -> - match efield.eexpr with - | TField(_, FEnum _) -> - { ecall with eexpr = TCall(efield, elist) } - | _ -> - { ecall with eexpr = TCall(efield, (List.map (fun t -> mk_tp t ecall.epos) params) @ elist) } - ); - - if not erase_generics then HardNullableSynf.configure gen - (fun e -> - match e.eexpr, real_type e.etype with - | TConst TThis, _ when gen.gcurrent_path = (["haxe";"lang"], "Null") -> - e - | TConst (TInt _ | TFloat _ | TBool _), _ -> - e - | _, TInst({ cl_path = (["haxe";"lang"], "Null") }, [t]) -> - let e = { e with eexpr = TParenthesis(e) } in - { (mk_field_access gen e "value" e.epos) with etype = t } - | _ -> - trace (debug_type e.etype); gen.gcon.error "This expression is not a Nullable expression" e.epos; die "" __LOC__ - ) - (fun v t has_value -> - match has_value, real_type v.etype with - | true, TDynamic _ | true, TAnon _ | true, TMono _ -> - { - eexpr = TCall(mk_static_field_access_infer null_t "ofDynamic" v.epos [t], [mk_tp t v.epos; v]); - etype = TInst(null_t, [t]); - epos = v.epos - } - | _ -> - { eexpr = TNew(null_t, [t], [gen.ghandle_cast t v.etype v; { eexpr = TConst(TBool has_value); etype = gen.gcon.basic.tbool; epos = v.epos } ]); etype = TInst(null_t, [t]); epos = v.epos } - ) - (fun e -> - { - eexpr = TCall( - { (mk_field_access gen { (mk_paren e) with etype = real_type e.etype } "toDynamic" e.epos) with etype = TFun([], t_dynamic) }, - []); - etype = t_dynamic; - epos = e.epos - } - ) - (fun e -> - mk_field_access gen { e with etype = real_type e.etype } "hasValue" e.epos - ) - (fun e1 e2 -> - mk (TCall(mk_field_access gen e1 "Equals" e1.epos, [e2])) basic.tbool e1.epos - ); - - - let explicit_fn_name c tl fname = - path_param_s (TClassDecl c) c.cl_path tl ^ "." ^ fname - in - - FixOverrides.configure ~explicit_fn_name:explicit_fn_name ~get_vmtype:real_type gen; - - let allowed_meta = Hashtbl.create 1 in - Hashtbl.add allowed_meta Meta.LoopLabel true; - Normalize.configure gen ~allowed_metas:allowed_meta; - - AbstractImplementationFix.configure gen; - - let cl_arg_exc = get_cl (get_type gen (["System"],"ArgumentException")) in - let cl_arg_exc_t = TInst (cl_arg_exc, []) in - let mk_arg_exception msg pos = mk (TNew (cl_arg_exc, [], [make_string gen.gcon.basic msg pos])) cl_arg_exc_t pos in - let closure_t = ClosuresToClass.DoubleAndDynamicClosureImpl.get_ctx gen (get_cl (get_type gen (["haxe";"lang"],"Function"))) 6 mk_arg_exception in - ClosuresToClass.configure gen closure_t; - - let enum_base = (get_cl (get_type gen (["haxe";"lang"],"Enum")) ) in - let type_enumindex = mk_static_field_access_infer gen.gclasses.cl_type "enumIndex" null_pos [] in - let mk_enum_index_call e p = - mk (TCall (type_enumindex, [e])) gen.gcon.basic.tint p - in - EnumToClass2.configure gen enum_base mk_enum_index_call; - - InterfaceVarsDeleteModf.configure gen; - - let dynamic_object = (get_cl (get_type gen (["haxe";"lang"],"DynamicObject")) ) in - - let object_iface = get_cl (get_type gen (["haxe";"lang"],"IHxObject")) in - - let empty_en = match get_type gen (["haxe";"lang"], "EmptyObject") with TEnumDecl e -> e | _ -> die "" __LOC__ in - let empty_ctor_type = TEnum(empty_en, []) in - let empty_en_expr = mk (TTypeExpr (TEnumDecl empty_en)) (mk_anon (ref (EnumStatics empty_en))) null_pos in - let empty_ctor_expr = mk (TField (empty_en_expr, FEnum(empty_en, PMap.find "EMPTY" empty_en.e_constrs))) empty_ctor_type null_pos in - OverloadingConstructor.configure ~empty_ctor_type:empty_ctor_type ~empty_ctor_expr:empty_ctor_expr gen; - - let rcf_static_find = mk_static_field_access_infer (get_cl (get_type gen (["haxe";"lang"], "FieldLookup"))) "findHash" null_pos [] in - let rcf_static_lookup = mk_static_field_access_infer (get_cl (get_type gen (["haxe";"lang"], "FieldLookup"))) "lookupHash" null_pos [] in - - let rcf_static_insert, rcf_static_remove = - let get_specialized_postfix t = match t with - | TAbstract({a_path = [],("Float" | "Int" as name)}, _) -> name - | TAnon _ | TDynamic _ -> "Dynamic" - | _ -> print_endline (debug_type t); die "" __LOC__ - in - (fun t -> mk_static_field_access_infer (get_cl (get_type gen (["haxe";"lang"], "FieldLookup"))) ("insert" ^ get_specialized_postfix t) null_pos []), - (fun t -> mk_static_field_access_infer (get_cl (get_type gen (["haxe";"lang"], "FieldLookup"))) ("remove" ^ get_specialized_postfix t) null_pos []) - in - - let can_be_float = like_float in - - let rcf_on_getset_field main_expr field_expr field may_hash may_set is_unsafe = - let is_float = can_be_float (real_type main_expr.etype) in - let fn_name = if is_some may_set then "setField" else "getField" in - let fn_name = if is_float then fn_name ^ "_f" else fn_name in - let pos = field_expr.epos in - - let is_unsafe = { eexpr = TConst(TBool is_unsafe); etype = basic.tbool; epos = pos } in - - let should_cast = match main_expr.etype with | TAbstract({ a_path = ([], "Float") }, []) -> false | _ -> true in - let infer = mk_static_field_access_infer runtime_cl fn_name field_expr.epos [] in - let first_args = - [ field_expr; { eexpr = TConst(TString field); etype = basic.tstring; epos = pos } ] - @ if is_some may_hash then [ { eexpr = TConst(TInt (get may_hash)); etype = basic.tint; epos = pos } ] else [] - in - let args = first_args @ match is_float, may_set with - | true, Some(set) -> - [ if should_cast then mk_cast basic.tfloat set else set ] - | false, Some(set) -> - [ set ] - | _ -> - [ is_unsafe ] - in - - let call = { main_expr with eexpr = TCall(infer,args) } in - let call = if is_float && should_cast then mk_cast main_expr.etype call else call in - call - in - - let rcf_on_call_field ecall field_expr field may_hash args = - let infer = mk_static_field_access_infer runtime_cl "callField" field_expr.epos [] in - - let hash_arg = match may_hash with - | None -> [] - | Some h -> [ { eexpr = TConst(TInt h); etype = basic.tint; epos = field_expr.epos } ] - in - - let arr_call = if args <> [] then - mk_nativearray_decl gen t_dynamic args ecall.epos - else - null (gen.gclasses.nativearray t_dynamic) ecall.epos - in - - let call_args = - [field_expr; { field_expr with eexpr = TConst(TString field); etype = basic.tstring } ] - @ hash_arg - @ [ arr_call ] - in - - mk_cast ecall.etype { ecall with eexpr = TCall(infer, call_args) } - in - - add_cast_handler gen; - if not erase_generics then - RealTypeParams.configure gen (fun e t -> gen.gwarning WGenerator ("Cannot cast to " ^ (debug_type t)) e.epos; mk_cast t e) ifaces (get_cl (get_type gen (["haxe";"lang"], "IGenericObject"))) - else - RealTypeParams.RealTypeParamsModf.configure gen (RealTypeParams.RealTypeParamsModf.set_only_hxgeneric gen); - - let flookup_cl = get_cl (get_type gen (["haxe";"lang"], "FieldLookup")) in - - let cl_field_exc = get_cl (get_type gen (["System"],"MemberAccessException")) in - let cl_field_exc_t = TInst (cl_field_exc, []) in - let mk_field_exception msg pos = mk (TNew (cl_field_exc, [], [make_string gen.gcon.basic msg pos])) cl_field_exc_t pos in - - let rcf_ctx = - ReflectionCFs.new_ctx - gen - closure_t - object_iface - true - rcf_on_getset_field - rcf_on_call_field - (fun hash hash_array length -> { hash with eexpr = TCall(rcf_static_find, [hash; hash_array; length]); etype=basic.tint }) - (fun hash -> { hash with eexpr = TCall(rcf_static_lookup, [hash]); etype = gen.gcon.basic.tstring }) - (fun hash_array length pos value -> - let ecall = mk (TCall(rcf_static_insert value.etype, [hash_array; length; pos; value])) (if erase_generics then hash_array.etype else basic.tvoid) hash_array.epos in - if erase_generics then { ecall with eexpr = TBinop(OpAssign, hash_array, ecall) } else ecall - ) - (fun hash_array length pos -> - let t = gen.gclasses.nativearray_type hash_array.etype in - { hash_array with eexpr = TCall(rcf_static_remove t, [hash_array; length; pos]); etype = gen.gcon.basic.tvoid } - ) - ( - let delete = mk_static_field_access_infer flookup_cl "deleteHashConflict" null_pos [] in - let get = mk_static_field_access_infer flookup_cl "getHashConflict" null_pos [] in - let set = mk_static_field_access_infer flookup_cl "setHashConflict" null_pos [] in - let add = mk_static_field_access_infer flookup_cl "addHashConflictNames" null_pos [] in - let conflict_t = TInst (get_cl (get_type gen (["haxe"; "lang"], "FieldHashConflict")), []) in - Some { - t = conflict_t; - get_conflict = (fun ehead ehash ename -> mk (TCall (get, [ehead; ehash; ename])) conflict_t ehead.epos); - set = (fun ehead ehash ename evalue -> mk (TCall (set, [ehead; ehash; ename; evalue])) basic.tvoid ehead.epos); - delete = (fun ehead ehash ename -> mk (TCall (delete, [ehead; ehash; ename])) basic.tbool ehead.epos); - add_names = (fun ehead earr -> mk (TCall (add, [ehead; earr])) basic.tvoid ehead.epos); - } - ) - mk_field_exception - in - - ReflectionCFs.UniversalBaseClass.configure gen (get_cl (get_type gen (["haxe";"lang"],"HxObject")) ) object_iface dynamic_object; - - ReflectionCFs.configure_dynamic_field_access rcf_ctx; - - let closure_cl = get_cl (get_type gen (["haxe";"lang"],"Closure")) in - let varargs_cl = get_cl (get_type gen (["haxe";"lang"],"VarArgsFunction")) in - let dynamic_name = mk_internal_name "hx" "invokeDynamic" in - - List.iter (fun cl -> - List.iter (fun cf -> - if cf.cf_name = dynamic_name then add_class_field_flag cf CfOverride - ) cl.cl_ordered_fields - ) [closure_cl; varargs_cl]; - - ReflectionCFs.implement_varargs_cl rcf_ctx ( get_cl (get_type gen (["haxe";"lang"], "VarArgsBase")) ); - - let slow_invoke_field = mk_static_field_access_infer runtime_cl "slowCallField" null_pos [] in - let slow_invoke ethis efield eargs = - mk (TCall (slow_invoke_field, [ethis; efield; eargs])) t_dynamic ethis.epos - in - ReflectionCFs.configure rcf_ctx object_iface ~slow_invoke:slow_invoke; - - ObjectDeclMap.configure gen (ReflectionCFs.implement_dynamic_object_ctor rcf_ctx dynamic_object); - - InitFunction.configure gen; - TArrayTransform.configure gen ( - fun e binop -> - match e.eexpr with - | TArray(e1, e2) -> - (match follow e1.etype with - | TDynamic _ | TAnon _ | TMono _ -> true - | TInst({ cl_kind = KTypeParameter _ }, _) -> true - | TInst(c,p) when erase_generics && is_hxgeneric (TClassDecl c) && is_hxgen (TClassDecl c) -> (match c.cl_path with - | [],"String" - | ["cs"],"NativeArray" -> false - | _ -> - true) - | _ -> match binop, change_param_type (t_to_md e1.etype) [e.etype] with - | Some(Ast.OpAssignOp _), ([TDynamic _] | [TAnon _]) -> - true - | _ -> false) - | _ -> die "" __LOC__ - ) "__get" "__set"; - - let field_is_dynamic t field = - match field_access_esp gen (gen.greal_type t) field with - | FEnumField _ -> false - | FClassField (cl,p,_,_,_,t,_) -> - if not erase_generics then - false - else - let p = change_param_type (TClassDecl cl) p in - is_dynamic (apply_params cl.cl_params p t) - | _ -> true - in - - let is_dynamic_expr e = is_dynamic e.etype || match e.eexpr with - | TField(tf, f) -> field_is_dynamic tf.etype (f) - | _ -> false - in - - let may_nullable t = match gen.gfollow#run_f t with - | TAbstract({ a_path = ([], "Null") }, [t]) -> - (match follow t with - | TInst({ cl_path = ([], "String") }, []) - | TAbstract ({ a_path = ([], "Float") },[]) - | TInst({ cl_path = (["haxe"], "Int32")}, [] ) - | TInst({ cl_path = (["haxe"], "Int64")}, [] ) - | TAbstract ({ a_path = ([], "Int") },[]) - | TAbstract ({ a_path = ([], "Bool") },[]) -> Some t - | TAbstract _ when like_float t -> Some t - | t when is_cs_basic_type t -> Some t - | _ -> None ) - | _ -> None - in - - let is_double t = like_float t && not (like_int t) in - let is_int t = like_int t in - - let is_null t = match real_type t with - | TInst( { cl_path = (["haxe";"lang"], "Null") }, _ ) -> true - | _ -> false - in - - let is_null_expr e = is_null e.etype || match e.eexpr with - | TField(tf, f) -> (match field_access_esp gen (real_type tf.etype) (f) with - | FClassField(_,_,_,_,_,actual_t,_) -> is_null actual_t - | _ -> false) - | _ -> false - in - - let should_handle_opeq t = - match real_type t with - | TDynamic _ | TAnon _ | TMono _ - | TInst( { cl_kind = KTypeParameter _ }, _ ) - | TInst( { cl_path = (["haxe";"lang"], "Null") }, _ ) -> true - | _ -> false - in - - let string_cl = match gen.gcon.basic.tstring with - | TInst(c,[]) -> c - | _ -> die "" __LOC__ - in - - let is_undefined e = match e.eexpr with - | TIdent "__undefined__" | TField(_,FStatic({cl_path=["haxe";"lang"],"Runtime"},{cf_name="undefined"})) -> true - | _ -> false - in - - let nullable_basic t = match gen.gfollow#run_f t with - | TType({ t_path = ([],"Null") }, [t]) - | TAbstract({ a_path = ([],"Null") }, [t]) when is_cs_basic_type t -> - Some(t) - | _ -> - None - in - - DynamicOperators.configure gen - ~handle_strings:false - (fun e -> match e.eexpr with - | TBinop (Ast.OpEq, e1, e2) - | TBinop (Ast.OpNotEq, e1, e2) -> - ( - (* dont touch (v == null) and (null == v) comparisons because they are handled by HardNullableSynf later *) - match e1.eexpr, e2.eexpr with - | TConst(TNull), _ when (not (is_tparam e2.etype) && is_dynamic e2.etype) || is_null_expr e2 -> - false - | _, TConst(TNull) when (not (is_tparam e1.etype) && is_dynamic e1.etype) || is_null_expr e1 -> - false - | _ when is_undefined e1 || is_undefined e2 -> - false - | _ -> - should_handle_opeq e1.etype || should_handle_opeq e2.etype - ) - | TBinop (Ast.OpAssignOp Ast.OpAdd, e1, e2) -> - is_dynamic_expr e1 || is_null_expr e1 || is_string e.etype - | TBinop (Ast.OpAdd, e1, e2) -> is_dynamic e1.etype || is_dynamic e2.etype || is_tparam e1.etype || is_tparam e2.etype || is_string e1.etype || is_string e2.etype || is_string e.etype - | TBinop (Ast.OpLt, e1, e2) - | TBinop (Ast.OpLte, e1, e2) - | TBinop (Ast.OpGte, e1, e2) - | TBinop (Ast.OpGt, e1, e2) -> is_dynamic e.etype || is_dynamic e1.etype || is_dynamic e2.etype || is_string e1.etype || is_string e2.etype - | TBinop (_, e1, e2) -> is_dynamic e.etype || is_dynamic_expr e1 || is_dynamic_expr e2 - | TUnop (_, _, e1) -> is_dynamic_expr e1 || is_null_expr e1 (* we will see if the expression is Null also, as the unwrap from Unop will be the same *) - | _ -> false) - (fun e1 e2 -> - let is_basic = is_cs_basic_type (follow e1.etype) || is_cs_basic_type (follow e2.etype) in - let is_ref = if is_basic then false else match follow e1.etype, follow e2.etype with - | TDynamic _, _ - | _, TDynamic _ - | TInst( { cl_path = ([], "String") }, [] ), _ - | _, TInst( { cl_path = ([], "String") }, [] ) - | TInst( { cl_kind = KTypeParameter _ }, [] ), _ - | _, TInst( { cl_kind = KTypeParameter _ }, [] ) -> false - | _, _ -> true - in - - let static = mk_static_field_access_infer (runtime_cl) (if is_ref then "refEq" else "eq") e1.epos [] in - { eexpr = TCall(static, [e1; e2]); etype = gen.gcon.basic.tbool; epos=e1.epos } - ) - (fun e e1 e2 -> - match may_nullable e1.etype, may_nullable e2.etype with - | Some t1, Some t2 -> - let t1, t2 = if is_string t1 || is_string t2 then - basic.tstring, basic.tstring - else if is_double t1 || is_double t2 then - basic.tfloat, basic.tfloat - else if is_int t1 || is_int t2 then - basic.tint, basic.tint - else t1, t2 in - { eexpr = TBinop(Ast.OpAdd, mk_cast t1 e1, mk_cast t2 e2); etype = e.etype; epos = e1.epos } - | _ when is_string e.etype || is_string e1.etype || is_string e2.etype -> - { - eexpr = TCall( - mk_static_field_access_infer runtime_cl "concat" e.epos [], - [ e1; e2 ] - ); - etype = basic.tstring; - epos = e.epos - } - | _ -> - let static = mk_static_field_access_infer (runtime_cl) "plus" e1.epos [] in - mk_cast e.etype { eexpr = TCall(static, [e1; e2]); etype = t_dynamic; epos=e1.epos }) - (fun op e e1 e2 -> - match nullable_basic e1.etype, nullable_basic e2.etype with - | Some(t1), None when is_cs_basic_type e2.etype -> - { e with eexpr = TBinop(op, mk_cast t1 e1, e2) } - | None, Some(t2) when is_cs_basic_type e1.etype -> - { e with eexpr = TBinop(op, e1, mk_cast t2 e2) } - | _ -> - let handler = if is_string e1.etype then begin - { e1 with eexpr = TCall(mk_static_field_access_infer string_cl "CompareOrdinal" e1.epos [], [ e1; e2 ]); etype = gen.gcon.basic.tint } - end else begin - let static = mk_static_field_access_infer (runtime_cl) "compare" e1.epos [] in - { eexpr = TCall(static, [e1; e2]); etype = gen.gcon.basic.tint; epos=e1.epos } - end - in - let zero = make_int gen.gcon.basic 0 e.epos in - { e with eexpr = TBinop(op, handler, zero) } - ); - - FilterClosures.configure gen (fun e1 s -> true) (ReflectionCFs.get_closure_func rcf_ctx closure_cl); - - ClassInstance.configure gen; - - CastDetect.configure gen (Some empty_ctor_type) (not erase_generics) ~overloads_cast_to_base:true; - - SwitchToIf.configure gen (fun e -> - match e.eexpr with - | TSwitch switch -> - (match gen.gfollow#run_f switch.switch_subject.etype with - | TAbstract ({ a_path = ([], "Int") },[]) - | TInst({ cl_path = ([], "String") },[]) -> - (List.exists (fun case -> - List.exists (fun expr -> match expr.eexpr with | TConst _ -> false | _ -> true ) case.case_patterns - ) switch.switch_cases) - | _ -> true - ) - | _ -> die "" __LOC__ - ); - - ExpressionUnwrap.configure gen; - - (* UnnecessaryCastsRemoval.configure gen; *) - - IntDivisionSynf.configure gen; - - UnreachableCodeEliminationSynf.configure gen false; - - ArraySpliceOptimization.configure gen; - - ArrayDeclSynf.configure gen native_arr_cl change_param_type; - - CSharpSpecificSynf.configure gen runtime_cl; - CSharpSpecificESynf.configure gen runtime_cl; - - let out_files = ref [] in - - (* copy resource files *) - if Hashtbl.length gen.gcon.resources > 0 then begin - let src = - gen.gcon.file ^ "/src/Resources" - in - Hashtbl.iter (fun name v -> - let name = StringHelper.escape_res_name name ['/'] in - let full_path = src ^ "/" ^ name in - Path.mkdir_from_path full_path; - - let f = open_out_bin full_path in - output_string f v; - close_out f; - - out_files := (gen.gcon.file_keys#get full_path) :: !out_files - ) gen.gcon.resources; - end; - (* add resources array *) - (try - let res = get_cl (Hashtbl.find gen.gtypes (["haxe"], "Resource")) in - let cf = PMap.find "content" res.cl_statics in - let res = ref [] in - Hashtbl.iter (fun name v -> - res := { eexpr = TConst(TString name); etype = gen.gcon.basic.tstring; epos = null_pos } :: !res; - ) gen.gcon.resources; - cf.cf_expr <- Some ({ eexpr = TArrayDecl(!res); etype = gen.gcon.basic.tarray gen.gcon.basic.tstring; epos = null_pos }) - with | Not_found -> ()); - - run_filters gen; - (* after the filters have been run, add all hashed fields to FieldLookup *) - - let normalize_i i = - let i = Int32.of_int (i) in - if i < Int32.zero then - Int32.logor (Int32.logand i (Int32.of_int 0x3FFFFFFF)) (Int32.shift_left Int32.one 30) - else i - in - - let nhash = ref 0 in - let hashes = Hashtbl.fold (fun i s acc -> incr nhash; (normalize_i i,s) :: acc) rcf_ctx.rcf_hash_fields [] in - let hashes = List.sort (fun (i,s) (i2,s2) -> compare i i2) hashes in - - let haxe_libs = List.filter (function net_lib -> is_some (net_lib#lookup (["haxe";"lang"], "DceNo"))) gen.gcon.native_libs.net_libs in - (try - (* first let's see if we're adding a -net-lib that has already a haxe.lang.FieldLookup *) - let net_lib = List.find (function net_lib -> is_some (net_lib#lookup (["haxe";"lang"], "FieldLookup"))) gen.gcon.native_libs.net_libs in - let name = net_lib#get_name in - if not (Common.defined gen.gcon Define.DllImport) then begin - gen.gwarning WGenerator ("The -net-lib with path " ^ name ^ " contains a Haxe-generated assembly. Please define `-D dll_import` to handle Haxe-generated dll import correctly") null_pos; - raise Not_found - end; - if not (List.exists (function net_lib -> net_lib#get_name = name) haxe_libs) then - gen.gwarning WGenerator ("The -net-lib with path " ^ name ^ " contains a Haxe-generated assembly, however it wasn't compiled with `-dce no`. Recompilation with `-dce no` is recommended") null_pos; - (* it has; in this case, we need to add the used fields on each __init__ *) - add_class_flag flookup_cl CExtern; - let hashs_by_path = Hashtbl.create !nhash in - Hashtbl.iter (fun (path,i) s -> Hashtbl.add hashs_by_path path (i,s)) rcf_ctx.rcf_hash_paths; - Hashtbl.iter (fun _ md -> match md with - | TClassDecl c when not (has_class_flag c CExtern) && not (has_class_flag c CInterface) -> (try - let all = Hashtbl.find_all hashs_by_path c.cl_path in - let all = List.map (fun (i,s) -> normalize_i i, s) all in - let all = List.sort (fun (i,s) (i2,s2) -> compare i i2) all in - - if all <> [] then begin - let add = mk_static_field_access_infer flookup_cl "addFields" c.cl_pos [] in - let expr = { eexpr = TCall(add, [ - 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 - TClass.add_cl_init c expr - end - with | Not_found -> ()) - | _ -> ()) gen.gtypes; - - with | Not_found -> try - let basic = gen.gcon.basic in - let cl = flookup_cl in - let field_ids = PMap.find "fieldIds" cl.cl_statics in - let fields = PMap.find "fields" cl.cl_statics in - - field_ids.cf_expr <- Some (mk_nativearray_decl gen basic.tint (List.map (fun (i,s) -> { eexpr = TConst(TInt (i)); etype = basic.tint; epos = field_ids.cf_pos }) hashes) field_ids.cf_pos); - fields.cf_expr <- Some (mk_nativearray_decl gen basic.tstring (List.map (fun (i,s) -> { eexpr = TConst(TString s); etype = basic.tstring; epos = fields.cf_pos }) hashes) fields.cf_pos); - - with | Not_found -> - gen.gcon.error "Fields 'fieldIds' and 'fields' were not found in class haxe.lang.FieldLookup" flookup_cl.cl_pos - ); - - if Common.defined gen.gcon Define.DllImport then begin - Hashtbl.iter (fun _ md -> match md with - | TClassDecl c when not (has_class_flag c CExtern) -> (try - let extra = match c.cl_params with - | _ :: _ when not erase_generics -> "_" ^ string_of_int (List.length c.cl_params) - | _ -> "" - in - let pack = match c.cl_path with - | ([], _) when no_root && is_hxgen (TClassDecl c) -> - ["haxe";"root"] - | (p,_) -> p - in - let path = (pack, snd c.cl_path ^ extra) in - ignore (List.find (function net_lib -> - is_some (net_lib#lookup path)) haxe_libs); - add_class_flag c CExtern; - with | Not_found -> ()) - | _ -> ()) gen.gtypes - end; - - RenameTypeParameters.run gen.gtypes_list; - - Path.mkdir_from_path gen.gcon.file; - - List.iter (fun md_def -> - let source_dir = gen.gcon.file ^ "/src/" ^ (String.concat "/" (fst (path_of_md_def md_def))) in - let w = SourceWriter.new_source_writer() in - let is_first_type = ref true in - let should_write = List.fold_left (fun should md -> module_type_gen w md is_first_type || should) false md_def.m_types in - if should_write then begin - let path = path_of_md_def md_def in - write_file gen w source_dir path "cs" out_files - end - ) gen.gmodules; - - if not (Common.defined gen.gcon Define.KeepOldOutput) then - clean_files gen (gen.gcon.file ^ "/src") !out_files gen.gcon.verbose; - - dump_descriptor gen ("hxcs_build.txt") s_type_path module_s; - if ( not (Common.defined gen.gcon Define.NoCompilation) ) then begin - let old_dir = Sys.getcwd() in - Sys.chdir gen.gcon.file; - let cmd = "haxelib" in - let args = ["run"; "hxcs"; "hxcs_build.txt"; "--haxe-version"; (string_of_int gen.gcon.version); "--feature-level"; "1"] in - let args = - match gen.gentry_point with - | Some (name,_,_) -> - let name = if gen.gcon.debug then name ^ "-Debug" else name in - args@["--out"; gen.gcon.file ^ "/bin/" ^ name] - | _ -> - args - in - print_endline (cmd ^ " " ^ (String.concat " " args)); - if gen.gcon.run_command_args cmd args <> 0 then failwith "Build failed"; - Sys.chdir old_dir; - end - - with TypeNotFound path -> - con.error ("Error. Module '" ^ (s_type_path path) ^ "' is required and was not included in build.") null_pos); - debug_mode := false diff --git a/src/generators/genjava.ml b/src/generators/genjava.ml deleted file mode 100644 index 1c50d324315..00000000000 --- a/src/generators/genjava.ml +++ /dev/null @@ -1,2711 +0,0 @@ -(* - The Haxe Compiler - Copyright (C) 2005-2019 Haxe Foundation - - This program is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License - as published by the Free Software Foundation; either version 2 - of the License, or (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. - *) -open Extlib_leftovers -open Globals -open Ast -open Common -open Type -open Gencommon -open Gencommon.SourceWriter -open Printf -open Option -open ExtString - -let is_boxed_type t = match follow t with - | TInst ({ cl_path = (["java";"lang"], "Boolean") }, []) - | TInst ({ cl_path = (["java";"lang"], "Double") }, []) - | TInst ({ cl_path = (["java";"lang"], "Integer") }, []) - | TInst ({ cl_path = (["java";"lang"], "Byte") }, []) - | TInst ({ cl_path = (["java";"lang"], "Short") }, []) - | TInst ({ cl_path = (["java";"lang"], "Character") }, []) - | TInst ({ cl_path = (["java";"lang"], "Float") }, []) - | TInst ({ cl_path = (["java";"lang"], "Long") }, []) -> true - | _ -> false - -let is_boxed_of_t boxed_t orig_t = match follow boxed_t, follow orig_t with - | TInst ({ cl_path = (["java";"lang"], "Boolean") }, []), - TAbstract({ a_path = ([],"Bool") }, []) - | TInst ({ cl_path = (["java";"lang"], "Double") }, []), - TAbstract({ a_path = ([],"Float") }, []) - | TInst ({ cl_path = (["java";"lang"], "Integer") }, []), - TAbstract({ a_path = ([],"Int") }, []) - | TInst ({ cl_path = (["java";"lang"], "Byte") }, []), - TAbstract({ a_path = (["java"],"Int8") }, []) - | TInst ({ cl_path = (["java";"lang"], "Short") }, []), - TAbstract({ a_path = (["java"],"Int16") }, []) - | TInst ({ cl_path = (["java";"lang"], "Character") }, []), - TAbstract({ a_path = (["java"],"Char16") }, []) - | TInst ({ cl_path = (["java";"lang"], "Float") }, []), - TAbstract({ a_path = ([],"Single") }, []) - | TInst ({ cl_path = (["java";"lang"], "Long") }, []), - TAbstract({ a_path = (["java"],"Int64") }, []) -> - true - | _ -> false - -let is_boxed_int_type boxed_t = match follow boxed_t with - | TInst ({ cl_path = (["java";"lang"], ("Integer"|"Byte"|"Short"|"Long")) }, []) -> - true - | _ -> false - -let is_int64_type t = match follow t with - | TAbstract ({ a_path = (["java"], ("Int64")) }, []) -> - true - | _ -> false - -let is_boxed_int64_type t = match follow t with - | TInst ({ cl_path = (["java";"lang"], ("Long")) }, []) -> - true - | _ -> false - -let is_int_type t = match follow t with - | TAbstract ({ a_path = ([], ("Int")) }, []) - | TAbstract ({ a_path = (["java"], ("Int8" | "Int16" | "Int64")) }, []) -> - true - | _ -> false - -let is_boxed_float_type boxed_t = match follow boxed_t with - | TInst ({ cl_path = (["java";"lang"], ("Double"|"Float")) }, []) -> - true - | _ -> false - -let is_float_type t = match follow t with - | TAbstract ({ a_path = ([], ("Float"|"Single")) }, []) -> - true - | _ -> false - -let is_boxed_number t = match follow t with - | TInst ({ cl_path = (["java";"lang"], ("Float"|"Double"|"Integer"|"Byte"|"Short"|"Long")) }, []) -> - true - | _ -> - false - -let is_unboxed_number t = match follow t with - | TAbstract ({ a_path = ([], ("Float"|"Single"|"Int")) }, []) - | TAbstract ({ a_path = (["java"], ("Int8" | "Int16" | "Int64")) }, []) -> - true - | _ -> false - -let rec t_has_type_param t = match follow t with - | TInst({ cl_kind = KTypeParameter _ }, []) -> true - | TEnum(_, params) - | TAbstract(_, params) - | TInst(_, params) -> List.exists t_has_type_param params - | TFun(f,ret) -> t_has_type_param ret || List.exists (fun (_,_,t) -> t_has_type_param t) f - | _ -> false - -let is_dynamic gen t = - match follow (gen.greal_type t) with - | TDynamic _ -> true - | _ -> false - -let is_type_param t = ExtType.is_type_param (follow t) - -let rec t_has_type_param_shallow last t = match follow t with - | TInst({ cl_kind = KTypeParameter _ }, []) -> true - | TEnum(_, params) - | TAbstract(_, params) - | TInst(_, params) when not last -> List.exists (t_has_type_param_shallow true) params - | TFun(f,ret) when not last -> t_has_type_param_shallow true ret || List.exists (fun (_,_,t) -> t_has_type_param_shallow true t) f - | _ -> false - -let rec replace_type_param t = match follow t with - | TInst({ cl_kind = KTypeParameter _ }, []) -> t_dynamic - | TEnum(e, params) -> TEnum(e, List.map replace_type_param params) - | TAbstract(a, params) -> TAbstract(a, List.map replace_type_param params) - | TInst(cl, params) -> TInst(cl, List.map replace_type_param params) - | _ -> t - -let in_runtime_class gen = - match gen.gcurrent_class with - | Some { cl_path = ["haxe";"lang"],"Runtime"} -> true - | _ -> false - -let is_java_basic_type t = - match follow t with - | TInst( { cl_path = (["haxe"], "Int32") }, [] ) - | TInst( { cl_path = (["haxe"], "Int64") }, [] ) - | TAbstract( { a_path = (["java"], ("Int8" | "Int16" | "Char16" | "Int64")) }, [] ) - | TAbstract( { a_path = ([], ("Int"|"Float"|"Bool"|"Single")) }, [] ) -> - true - | _ -> false - -let is_bool t = - match follow t with - | TAbstract ({ a_path = ([], "Bool") },[]) -> - true - | _ -> false - -let like_bool t = - match follow t with - | TAbstract ({ a_path = ([], "Bool") },[]) - | TAbstract ({ a_path = (["java";"lang"],"Boolean") },[]) - | TInst ({ cl_path = (["java";"lang"],"Boolean") },[]) -> - true - | _ -> false - -let is_int_float gen t = - match follow (gen.greal_type t) with - | TInst( { cl_path = (["haxe"], "Int32") }, [] ) - | TAbstract( { a_path = ([], "Int") }, [] ) - | TAbstract( { a_path = ([], "Float") }, [] ) -> - true - | (TAbstract _ as t) when like_float t && not (like_i64 t)-> true - | _ -> false - -let parse_explicit_iface = - let regex = Str.regexp "\\." in - let parse_explicit_iface str = - let split = Str.split regex str in - let rec get_iface split pack = - match split with - | clname :: fn_name :: [] -> fn_name, (List.rev pack, clname) - | pack_piece :: tl -> get_iface tl (pack_piece :: pack) - | _ -> die "" __LOC__ - in - get_iface split [] - in parse_explicit_iface - -let is_cl t = match follow t with - | TInst({ cl_path = ["java";"lang"],"Class" },_) - | TAbstract({ a_path = [], ("Class"|"Enum") },_) -> true - | TAnon(a) when is_some (anon_class t) -> true - | _ -> false - -let mk_cast_if_needed t_to e = - if type_iseq t_to e.etype then - e - else - mk_cast t_to e - -(* ******************************************* *) -(* JavaSpecificESynf *) -(* ******************************************* *) -(* - Some Java-specific syntax filters that must run before ExpressionUnwrap - - dependencies: - It must run before ExprUnwrap, as it may not return valid Expr/Statement expressions - It must run before ClassInstance, as it will detect expressions that need unchanged TTypeExpr - It must run after CastDetect, as it changes casts - It must run after TryCatchWrapper, to change Std.is() calls inside there -*) -module JavaSpecificESynf = -struct - let name = "java_specific_e" - let priority = solve_deps name [ DBefore ExpressionUnwrap.priority; DBefore ClassInstance.priority; DAfter CastDetect.priority] - - let get_cl_from_t t = - match follow t with - | TInst(cl,_) -> cl - | _ -> die "" __LOC__ - - let configure gen runtime_cl = - let basic = gen.gcon.basic in - let float_cl = get_cl ( get_type gen (["java";"lang"], "Double")) in - let i8_md = ( get_type gen (["java";"lang"], "Byte")) in - let i16_md = ( get_type gen (["java";"lang"], "Short")) in - let i64_md = ( get_type gen (["java";"lang"], "Long")) in - let c16_md = ( get_type gen (["java";"lang"], "Character")) in - let f_md = ( get_type gen (["java";"lang"], "Float")) in - let bool_md = get_type gen (["java";"lang"], "Boolean") in - - let rec run e = - match e.eexpr with - (* Math changes *) - | TField( _, FStatic({ cl_path = (["java";"lang"], "Math") }, { cf_name = "NaN" }) ) -> - mk_static_field_access_infer float_cl "NaN" e.epos [] - | TField( _, FStatic({ cl_path = (["java";"lang"], "Math") }, { cf_name = "NEGATIVE_INFINITY" }) ) -> - mk_static_field_access_infer float_cl "NEGATIVE_INFINITY" e.epos [] - | TField( _, FStatic({ cl_path = (["java";"lang"], "Math") }, { cf_name = "POSITIVE_INFINITY" }) ) -> - mk_static_field_access_infer float_cl "POSITIVE_INFINITY" e.epos [] - | TField( _, FStatic({ cl_path = (["java";"lang"], "Math") }, { cf_name = "isNaN"}) ) -> - mk_static_field_access_infer float_cl "isNaN" e.epos [] - | TCall( ({ eexpr = TField( (_ as ef), FStatic({ cl_path = (["java";"lang"], "Math") }, { cf_name = ("ffloor" as f) }) ) } as fe), p) - | TCall( ({ eexpr = TField( (_ as ef), FStatic({ cl_path = (["java";"lang"], "Math") }, { cf_name = ("fceil" as f) }) ) } as fe), p) -> - Type.map_expr run { e with eexpr = TCall({ fe with eexpr = TField(ef, FDynamic (String.sub f 1 (String.length f - 1))) }, p) } - | TCall( { eexpr = TField( _, FStatic({ cl_path = (["java";"lang"], "Math") }, { cf_name = "floor" }) ) }, _) - | TCall( { eexpr = TField( _, FStatic({ cl_path = (["java";"lang"], "Math") }, { cf_name = "round" }) ) }, _) - | TCall( { eexpr = TField( _, FStatic({ cl_path = (["java";"lang"], "Math") }, { cf_name = "ceil" }) ) }, _) -> - mk_cast basic.tint (Type.map_expr run { e with etype = basic.tfloat }) - | TCall( ( { eexpr = TField( _, FStatic({ cl_path = (["java";"lang"], "Math") }, { cf_name = "isFinite" }) ) } as efield ), [v]) -> - { e with eexpr = TCall( mk_static_field_access_infer runtime_cl "isFinite" efield.epos [], [run v] ) } - (* end of math changes *) - - (* Std.is() *) - | TCall( - { eexpr = TField( _, FStatic({ cl_path = ([], "Std") }, { cf_name = ("is" | "isOfType") })) }, - [ obj; { eexpr = TTypeExpr(md) } ] - ) -> - let mk_is is_basic obj md = - let obj = if is_basic then mk_cast t_dynamic obj else obj in - { e with eexpr = TCall( { eexpr = TIdent "__is__"; etype = t_dynamic; epos = e.epos }, [ - run obj; - { eexpr = TTypeExpr md; etype = t_dynamic (* this is after all a syntax filter *); epos = e.epos } - ] ) } - in - (match follow_module follow md with - | TAbstractDecl({ a_path = ([], "Float") }) -> - { - eexpr = TCall( - mk_static_field_access_infer runtime_cl "isDouble" e.epos [], - [ run obj ] - ); - etype = basic.tbool; - epos = e.epos - } - | TAbstractDecl{ a_path = ([], "Int") } -> - { - eexpr = TCall( - mk_static_field_access_infer runtime_cl "isInt" e.epos [], - [ run obj ] - ); - etype = basic.tbool; - epos = e.epos - } - | TAbstractDecl{ a_path = ([], "Bool") } -> - mk_is true obj bool_md - | TAbstractDecl{ a_path = ([], "Single") } -> - mk_is true obj f_md - | TAbstractDecl{ a_path = (["java"], "Int8") } -> - mk_is true obj i8_md - | TAbstractDecl{ a_path = (["java"], "Int16") } -> - mk_is true obj i16_md - | TAbstractDecl{ a_path = (["java"], "Char16") } -> - mk_is true obj c16_md - | TAbstractDecl{ a_path = (["java"], "Int64") } -> - mk_is true obj i64_md - | TClassDecl{ cl_path = (["haxe"], "Int64") } -> - mk_is true obj i64_md - | TAbstractDecl{ a_path = ([], "Dynamic") } - | TClassDecl{ cl_path = ([], "Dynamic") } when not (is_nullable obj.etype) -> - (match obj.eexpr with - | TLocal _ | TConst _ -> { e with eexpr = TConst(TBool true) } - | _ -> { e with eexpr = TBlock([run obj; { e with eexpr = TConst(TBool true) }]) } - ) - | _ -> - if not (is_java_basic_type obj.etype) then - try - Type.unify obj.etype (type_of_module_type md); - mk_is false obj md - with Unify_error _ -> e - else e - ) - (* end Std.is() *) - | _ -> Type.map_expr run e - in - gen.gsyntax_filters#add name (PCustom priority) run - -end;; - - -(* ******************************************* *) -(* JavaSpecificSynf *) -(* ******************************************* *) -(* - Some Java-specific syntax filters that can run after ExprUnwrap - - dependencies: - Runs after ExprUnwarp -*) -module JavaSpecificSynf = -struct - let name = "java_specific" - let priority = solve_deps name [ DAfter ExpressionUnwrap.priority; DAfter ObjectDeclMap.priority; DAfter ArrayDeclSynf.priority; DBefore IntDivisionSynf.priority ] - - let java_hash s = - let high_surrogate c = (c lsr 10) + 0xD7C0 in - let low_surrogate c = (c land 0x3FF) lor 0xDC00 in - let h = ref Int32.zero in - let thirtyone = Int32.of_int 31 in - (try - UTF8.validate s; - UTF8.iter (fun c -> - let c = (UCharExt.code c) in - if c > 0xFFFF then - (h := Int32.add (Int32.mul thirtyone !h) - (Int32.of_int (high_surrogate c)); - h := Int32.add (Int32.mul thirtyone !h) - (Int32.of_int (low_surrogate c))) - else - h := Int32.add (Int32.mul thirtyone !h) - (Int32.of_int c) - ) s - with UTF8.Malformed_code -> - String.iter (fun c -> - h := Int32.add (Int32.mul thirtyone !h) - (Int32.of_int (Char.code c))) s - ); - !h - - let rec is_final_return_expr is_switch e = - let is_final_return_expr = is_final_return_expr is_switch in - match e.eexpr with - | TReturn _ - | TThrow _ -> true - (* this is hack to not use 'break' on switch cases *) - | TIdent "__fallback__" when is_switch -> true - | TMeta ((Meta.LoopLabel,_,_), { eexpr = TBreak }) -> true - | TParenthesis p | TMeta (_,p) -> is_final_return_expr p - | TBlock bl -> is_final_return_block is_switch bl - | TSwitch switch -> - List.for_all (fun case -> is_final_return_expr case.case_expr) switch.switch_cases && Option.map_default is_final_return_expr false switch.switch_default - | TIf (_,eif, Some eelse) -> - is_final_return_expr eif && is_final_return_expr eelse - | TFor (_,_,e) -> - is_final_return_expr e - | TWhile (_,e,_) -> - is_final_return_expr e - | TFunction tf -> - is_final_return_expr tf.tf_expr - | TTry (e, ve_l) -> - is_final_return_expr e && List.for_all (fun (_,e) -> is_final_return_expr e) ve_l - | _ -> false - - and is_final_return_block is_switch el = - match el with - | [] -> false - | final :: [] -> is_final_return_expr is_switch final - | hd :: tl -> is_final_return_block is_switch tl - - let rec is_null e = match e.eexpr with - | TConst(TNull) -> true - | TParenthesis(e) - | TMeta(_,e) -> is_null e - | _ -> false - - let rec is_equatable gen t = - match follow t with - | TInst(cl,_) -> - if cl.cl_path = (["haxe";"lang"], "IEquatable") then - true - else - List.exists (fun (cl,p) -> is_equatable gen (TInst(cl,p))) cl.cl_implements - || (match cl.cl_super with | Some(cl,p) -> is_equatable gen (TInst(cl,p)) | None -> false) - | _ -> false - - (* - Changing string switch - will take an expression like - switch(str) - { - case "a": - case "b": - } - - and modify it to: - { - var execute_def = true; - switch(str == null ? 0 : str.hashCode()) - { - case (hashcode of a): - if (str == "a") - { - execute_def = false; - ..code here - } //else if (str == otherVariableWithSameHashCode) { - ... - } - ... - } - if (execute_def) - { - ..default code - } - } - - this might actually be slower in some cases than a if/else approach, but it scales well and as a bonus, - hashCode in java are cached, so we only have the performance hit once to cache it. - *) - let change_string_switch gen eswitch e1 ecases edefault = - let basic = gen.gcon.basic in - let is_final_ret = is_final_return_expr false eswitch in - - let has_default = is_some edefault in - let block = ref [] in - let local = match e1.eexpr with - | TLocal _ -> e1 - | _ -> - let var = mk_temp "svar" e1.etype in - let added = { e1 with eexpr = TVar(var, Some(e1)); etype = basic.tvoid } in - let local = mk_local var e1.epos in - block := added :: !block; - local - in - let execute_def_var = mk_temp "executeDef" gen.gcon.basic.tbool in - let execute_def = mk_local execute_def_var e1.epos in - let execute_def_set = { eexpr = TBinop(Ast.OpAssign, execute_def, { eexpr = TConst(TBool false); etype = basic.tbool; epos = e1.epos }); etype = basic.tbool; epos = e1.epos } in - - let hash_cache = ref None in - - let local_hashcode = ref { local with - eexpr = TCall({ local with - eexpr = TField(local, FDynamic "hashCode"); - etype = TFun([], basic.tint); - }, []); - etype = basic.tint - } in - - let get_hash_cache () = - match !hash_cache with - | Some c -> c - | None -> - let var = mk_temp "hash" basic.tint in - let cond = !local_hashcode in - block := { eexpr = TVar(var, Some cond); etype = basic.tvoid; epos = local.epos } :: !block; - let local = mk_local var local.epos in - local_hashcode := local; - hash_cache := Some local; - local - in - - let has_case = ref false in - (* first we need to reorder all cases so all collisions are close to each other *) - - let get_str e = match e.eexpr with | TConst(TString s) -> s | _ -> die "" __LOC__ in - let has_conflict = ref false in - - let rec reorder_cases unordered ordered = - match unordered with - | [] -> ordered - | {case_patterns = el;case_expr = e} :: tl -> - let current = Hashtbl.create 1 in - List.iter (fun e -> - let str = get_str e in - let hash = java_hash str in - Hashtbl.add current hash true - ) el; - - let rec extract_fields cases found_cases ret_cases = - match cases with - | [] -> found_cases, ret_cases - | {case_patterns = el;case_expr = e} :: tl -> - if List.exists (fun e -> Hashtbl.mem current (java_hash (get_str e)) ) el then begin - has_conflict := true; - List.iter (fun e -> Hashtbl.add current (java_hash (get_str e)) true) el; - extract_fields tl ( {case_patterns = el;case_expr = e} :: found_cases ) ret_cases - end else - extract_fields tl found_cases ( {case_patterns = el;case_expr = e} :: ret_cases ) - in - let found, remaining = extract_fields tl [] [] in - let ret = if found <> [] then - let ret = List.sort (fun case1 case2 -> compare (List.length case2.case_patterns) (List.length case1.case_patterns) ) ( {case_patterns = el;case_expr = e} :: found ) in - let rec loop ret acc = - match ret with - | {case_patterns = el;case_expr = e} :: ( _ :: _ as tl ) -> loop tl ( (true, el, e) :: acc ) - | {case_patterns = el;case_expr = e} :: [] -> ( (false, el, e) :: acc ) - | _ -> die "" __LOC__ - in - List.rev (loop ret []) - else - (false, el, e) :: [] - in - - reorder_cases remaining (ordered @ ret) - in - - let already_in_cases = Hashtbl.create 0 in - let change_case (has_fallback, el, e) = - let conds, el = List.fold_left (fun (conds,el) e -> - has_case := true; - match e.eexpr with - | TConst(TString s) -> - let hashed = java_hash s in - let equals_test = { - eexpr = TCall({ e with eexpr = TField(local, FDynamic "equals"); etype = TFun(["obj",false,t_dynamic],basic.tbool) }, [ e ]); - etype = basic.tbool; - epos = e.epos - } in - - let hashed_expr = { eexpr = TConst(TInt hashed); etype = basic.tint; epos = e.epos } in - let hashed_exprs = if !has_conflict then begin - if Hashtbl.mem already_in_cases hashed then - el - else begin - Hashtbl.add already_in_cases hashed true; - hashed_expr :: el - end - end else hashed_expr :: el in - - let conds = match conds with - | None -> equals_test - | Some c -> - (* - if there is more than one case, we should test first if hash equals to the one specified. - This way we can save a heavier string compare - *) - let equals_test = mk_paren { - eexpr = TBinop(Ast.OpBoolAnd, { eexpr = TBinop(Ast.OpEq, get_hash_cache(), hashed_expr); etype = basic.tbool; epos = e.epos }, equals_test); - etype = basic.tbool; - epos = e.epos; - } in - - { eexpr = TBinop(Ast.OpBoolOr, equals_test, c); etype = basic.tbool; epos = e1.epos } - in - - Some conds, hashed_exprs - | _ -> die "" __LOC__ - ) (None,[]) el in - let e = if has_default then Type.concat execute_def_set e else e in - let e = if !has_conflict then Type.concat e { e with eexpr = TBreak; etype = basic.tvoid } else e in - let e = { - eexpr = TIf(get conds, e, None); - etype = basic.tvoid; - epos = e.epos - } in - - let e = if has_fallback then { e with eexpr = TBlock([ e; mk (TIdent "__fallback__") t_dynamic e.epos]) } else e in - - {case_patterns = el;case_expr = e} - in - - let is_not_null_check = mk (TBinop (OpNotEq, local, { local with eexpr = TConst TNull })) basic.tbool local.epos in - let if_not_null e = { e with eexpr = TIf (is_not_null_check, e, None) } in - let switch = mk_switch !local_hashcode (List.map change_case (reorder_cases ecases [])) None false (* idk *) in - let switch = if_not_null { eswitch with - eexpr = TSwitch switch; - } in - (if !has_case then begin - (if has_default then block := { e1 with eexpr = TVar(execute_def_var, Some({ e1 with eexpr = TConst(TBool true); etype = basic.tbool })); etype = basic.tvoid } :: !block); - block := switch :: !block - end); - (match edefault with - | None -> () - | Some edef when not !has_case -> - block := edef :: !block - | Some edef -> - let eelse = if is_final_ret then Some { eexpr = TThrow { eexpr = TConst(TNull); etype = t_dynamic; epos = edef.epos }; etype = basic.tvoid; epos = edef.epos } else None in - block := { edef with eexpr = TIf(execute_def, edef, eelse); etype = basic.tvoid } :: !block - ); - { eswitch with eexpr = TBlock(List.rev !block) } - - - let get_cl_from_t t = - match follow t with - | TInst(cl,_) -> cl - | _ -> die "" __LOC__ - - let configure gen runtime_cl = - let cl_boolean = get_cl (get_type gen (["java";"lang"],"Boolean")) in - let cl_number = get_cl (get_type gen (["java";"lang"],"Number")) in - - (if java_hash "Testing string hashCode implementation from haXe" <> (Int32.of_int 545883604) then die "" __LOC__); - let basic = gen.gcon.basic in - let tbyte = mt_to_t_dyn ( get_type gen (["java"], "Int8") ) in - let tshort = mt_to_t_dyn ( get_type gen (["java"], "Int16") ) in - let tsingle = mt_to_t_dyn ( get_type gen ([], "Single") ) in - let ti64 = mt_to_t_dyn ( get_type gen (["java"], "Int64") ) in - let string_ext = get_cl ( get_type gen (["haxe";"lang"], "StringExt")) in - let fast_cast = Common.defined gen.gcon Define.FastCast in - - let get_unboxed_from_boxed boxed_t = - match boxed_t with - | TInst( ({ cl_path = (["java";"lang"],name) } as cl), [] ) -> (match name with - | "Double" -> - cl, basic.tfloat - | "Integer" -> - cl, basic.tint - | "Byte" -> - cl, tbyte - | "Short" -> - cl, tshort - | "Float" -> - cl, tsingle - | "Long" -> - cl, ti64 - | _ -> - die "" __LOC__) - | _ -> die "" __LOC__ - in - - let mk_valueof_call boxed_t expr = - let box_cl, unboxed_t = get_unboxed_from_boxed boxed_t in - let fn = TFun(["param1",false,unboxed_t],boxed_t) in - { - eexpr = TCall(mk_static_field_access box_cl "valueOf" fn expr.epos, [mk_cast_if_needed unboxed_t expr]); - etype = boxed_t; - epos = expr.epos; - } - in - - let mk_unbox unboxed_t boxed_e = - if is_int64_type unboxed_t then - { - eexpr = TCall( - mk_static_field_access_infer runtime_cl "getInt64FromNumber" boxed_e.epos [], - [ boxed_e ] - ); - etype = ti64; - epos = boxed_e.epos - } - else if is_int_type unboxed_t then - mk_cast_if_needed unboxed_t { - eexpr = TCall( - mk_static_field_access_infer runtime_cl "getIntFromNumber" boxed_e.epos [], - [ boxed_e ] - ); - etype = basic.tint; - epos = boxed_e.epos - } - else - mk_cast_if_needed unboxed_t { - eexpr = TCall( - mk_static_field_access_infer runtime_cl "getFloatFromNumber" boxed_e.epos [], - [ boxed_e ] - ); - etype = basic.tfloat; - epos = boxed_e.epos - } - in - - let mk_dyn_box boxed_t expr = - let name = match boxed_t with - | TInst({ cl_path = (["java";"lang"],"Integer") },[]) -> - "numToInteger" - | TInst({ cl_path = (["java";"lang"],"Double") },[]) -> - "numToDouble" - | TInst({ cl_path = (["java";"lang"],"Float") },[]) -> - "numToFloat" - | TInst({ cl_path = (["java";"lang"],"Byte") },[]) -> - "numToByte" - | TInst({ cl_path = (["java";"lang"],"Long") },[]) -> - "numToLong" - | TInst({ cl_path = (["java";"lang"],"Short") },[]) -> - "numToShort" - | _ -> gen.gcon.error ("Invalid boxed type " ^ (debug_type boxed_t)) expr.epos; die "" __LOC__ - in - { - eexpr = TCall( - mk_static_field_access_infer runtime_cl name expr.epos [], - [ mk_cast (TInst(cl_number,[])) expr ] - ); - etype = boxed_t; - epos = expr.epos - } - in - - let rec run e = - match e.eexpr with - (* for new NativeArray issues *) - | TNew(({ cl_path = (["java"], "NativeArray") } as cl), [t], el) when is_type_param t -> - mk_cast (TInst(cl,[t])) (mk_cast t_dynamic ({ e with eexpr = TNew(cl, [t_empty], List.map run el) })) - - (* Std.int() *) - | TCall( - { eexpr = TField( _, FStatic({ cl_path = ([], "Std") }, { cf_name = "int" })) }, - [obj] - ) -> - run (mk_cast basic.tint obj) - (* end Std.int() *) - - | TField( ef, FInstance({ cl_path = ([], "String") }, _, { cf_name = "length" }) ) -> - { e with eexpr = TCall(Type.map_expr run e, []) } - | TField( ef, field ) when field_name field = "length" && is_string ef.etype -> - { e with eexpr = TCall(Type.map_expr run e, []) } - | TCall( ( { eexpr = TField(ef, field) } as efield ), args ) when is_string ef.etype && String.get (field_name field) 0 = '_' -> - let field = field_name field in - { e with eexpr = TCall({ efield with eexpr = TField(run ef, FDynamic (String.sub field 1 ( (String.length field) - 1)) )}, List.map run args) } - | TCall( ( { eexpr = TField(ef, FInstance({ cl_path = [], "String" }, _, field )) } as efield ), args ) -> - let field = field.cf_name in - (match field with - | "charAt" | "charCodeAt" | "split" | "indexOf" - | "lastIndexOf" | "substring" | "substr" -> - { e with eexpr = TCall(mk_static_field_access_infer string_ext field e.epos [], [run ef] @ (List.map run args)) } - | _ -> - { e with eexpr = TCall(run efield, List.map run args) } - ) - - | TCast(expr, _) when is_boxed_number (gen.greal_type expr.etype) && is_unboxed_number (gen.greal_type e.etype) -> - let to_t = gen.greal_type e.etype in - mk_unbox to_t (run expr) - - | TCast(expr, md) when is_boxed_number (gen.greal_type e.etype) -> - let to_t = gen.greal_type e.etype in - let from_t = gen.greal_type expr.etype in - let ret = if is_unboxed_number from_t then - mk_valueof_call to_t (run expr) - else if is_boxed_number from_t then - if type_iseq from_t to_t then begin - (* special case for when the expression is null, as we sometimes need to give *) - (* a little help to Java's typer *) - if is_null expr then - { e with eexpr = TCast(run expr, md) } - else - run expr - end else - mk_dyn_box (gen.greal_type e.etype) (run expr) - else begin - if in_runtime_class gen then - mk_cast e.etype (run expr) - else - mk_dyn_box (gen.greal_type e.etype) (run expr) - end - in - ret - - | TCast(expr, _) when is_bool e.etype -> - { - eexpr = TCall( - mk_static_field_access_infer runtime_cl "toBool" expr.epos [], - [ mk_cast_if_needed (TInst(cl_boolean,[])) (run expr) ] - ); - etype = basic.tbool; - epos = e.epos - } - - | TCast(expr, _) when is_int_float gen e.etype && is_dynamic gen expr.etype -> - let needs_cast = match gen.gfollow#run_f e.etype with - | TInst _ -> false - | _ -> true - in - - let fun_name = if like_int e.etype then "toInt" else "toDouble" in - - let ret = { - eexpr = TCall( - mk_static_field_access_infer runtime_cl fun_name expr.epos [], - [ run expr ] - ); - etype = if fun_name = "toDouble" then basic.tfloat else basic.tint; - epos = expr.epos - } in - - if needs_cast then mk_cast e.etype ret else ret - - | TCast(expr, _) when like_i64 e.etype && is_dynamic gen expr.etype -> - { - eexpr = TCall( - mk_static_field_access_infer runtime_cl "toLong" expr.epos [], - [ run expr ] - ); - etype = ti64; - epos = expr.epos - } - - | TCast(expr, Some(TClassDecl cls)) when fast_cast && cls == null_class -> - { e with eexpr = TCast(run expr, Some(TClassDecl null_class)) } - - | TBinop( (Ast.OpAssignOp OpAdd as op), e1, e2) - | TBinop( (Ast.OpAdd as op), e1, e2) when not fast_cast && (is_string e.etype || is_string e1.etype || is_string e2.etype) -> - let is_assign = match op with Ast.OpAssignOp _ -> true | _ -> false in - let mk_to_string e = { e with eexpr = TCall( mk_static_field_access_infer runtime_cl "toString" e.epos [], [run e] ); etype = gen.gcon.basic.tstring } in - let check_cast e = match gen.greal_type e.etype with - | TDynamic _ - | TAbstract({ a_path = ([], "Float") }, []) - | TAbstract({ a_path = ([], "Single") }, []) -> - mk_to_string e - | _ -> run e - in - - { e with eexpr = TBinop(op, (if is_assign then run e1 else check_cast e1), check_cast e2) } - | TCast(expr, _) when is_string e.etype -> - { e with eexpr = TCall( mk_static_field_access_infer runtime_cl "toString" expr.epos [], [run expr] ) } - - | TSwitch switch when is_string switch.switch_subject.etype -> - (*let change_string_switch gen eswitch e1 ecases edefault =*) - change_string_switch gen e (run switch.switch_subject) (List.map (fun case -> {case with case_expr = run case.case_expr}) switch.switch_cases) (Option.map run switch.switch_default) - - | TBinop( (Ast.OpNotEq as op), e1, e2) - | TBinop( (Ast.OpEq as op), e1, e2) when not (is_null e2 || is_null e1) && (is_string e1.etype || is_string e2.etype || is_equatable gen e1.etype || is_equatable gen e2.etype) -> - let static = mk_static_field_access_infer (runtime_cl) "valEq" e1.epos [] in - let eret = { eexpr = TCall(static, [run e1; run e2]); etype = gen.gcon.basic.tbool; epos=e.epos } in - if op = Ast.OpNotEq then { eret with eexpr = TUnop(Ast.Not, Ast.Prefix, eret) } else eret - - | TBinop( (Ast.OpNotEq | Ast.OpEq as op), e1, e2) when is_cl e1.etype && is_cl e2.etype -> - { e with eexpr = TBinop(op, mk_cast t_empty (run e1), mk_cast t_empty (run e2)) } - | _ -> Type.map_expr run e - in - gen.gsyntax_filters#add name (PCustom priority) run -end;; - - -(* ******************************************* *) -(* handle @:throws *) -(* ******************************************* *) -let rec is_checked_exc cl = - match cl.cl_path with - | ["java";"lang"],"RuntimeException" -> - false - | ["java";"lang"],"Throwable" -> - true - | _ -> match cl.cl_super with - | None -> false - | Some(c,_) -> is_checked_exc c - -let rec cls_any_super cl supers = - PMap.mem cl.cl_path supers || match cl.cl_super with - | None -> false - | Some(c,_) -> cls_any_super c supers - -let rec handle_throws gen cf = - List.iter (handle_throws gen) cf.cf_overloads; - match cf.cf_expr with - | Some ({ eexpr = TFunction(tf) } as e) -> - let rec collect_throws acc = function - | (Meta.Throws, [Ast.EConst (Ast.String(path,_)), _],_) :: meta -> (try - collect_throws (get_cl ( get_type gen (parse_path path)) :: acc) meta - with | Not_found | TypeNotFound _ -> - collect_throws acc meta) - | [] -> - acc - | _ :: meta -> - collect_throws acc meta - in - let cf_throws = collect_throws [] cf.cf_meta in - let throws = ref (List.fold_left (fun map cl -> - PMap.add cl.cl_path cl map - ) PMap.empty cf_throws) in - let rec iter e = match e.eexpr with - | TTry(etry,ecatches) -> - let old = !throws in - let needs_check_block = ref true in - List.iter (fun (v,e) -> - Type.iter iter e; - match follow (run_follow gen v.v_type) with - | TInst({ cl_path = ["java";"lang"],"Throwable" },_) - | TDynamic _ -> - needs_check_block := false - | TInst(c,_) when is_checked_exc c -> - throws := PMap.add c.cl_path c !throws - | _ ->() - ) ecatches; - if !needs_check_block then Type.iter iter etry; - throws := old - | TField(e, (FInstance(_,_,f) | FStatic(_,f) | FClosure(_,f))) -> - let tdefs = collect_throws [] f.cf_meta in - if tdefs <> [] && not (List.for_all (fun c -> cls_any_super c !throws) tdefs) then - raise Exit; - Type.iter iter e - | TThrow e -> (match follow (run_follow gen e.etype) with - | TInst(c,_) when is_checked_exc c && not (cls_any_super c !throws) -> - raise Exit - | _ -> iter e) - | _ -> Type.iter iter e - in - (try - Type.iter iter e - with | Exit -> (* needs typed exception to be caught *) - let throwable = get_cl (get_type gen (["java";"lang"],"Throwable")) in - let cast_cl = get_cl (get_type gen (["java";"lang"],"RuntimeException")) in - let catch_var = alloc_var "typedException" (TInst(throwable,[])) in - let rethrow = mk_local catch_var e.epos in - let hx_exception = get_cl (get_type gen (["haxe"], "Exception")) in - let wrap_static = mk_static_field_access (hx_exception) "thrown" (TFun([("obj",false,t_dynamic)], t_dynamic)) rethrow.epos in - let thrown_value = mk_cast (TInst(cast_cl,[])) { rethrow with eexpr = TCall(wrap_static, [rethrow]) } in - let wrapped = { rethrow with eexpr = TThrow thrown_value; } in - let map_throws cl = - let var = alloc_var "typedException" (TInst(cl,List.map (fun _ -> t_dynamic) cl.cl_params)) in - var, { tf.tf_expr with eexpr = TThrow (mk_local var e.epos) } - in - cf.cf_expr <- Some { e with - eexpr = TFunction({ tf with - tf_expr = mk_block { tf.tf_expr with eexpr = TTry(tf.tf_expr, List.map (map_throws) cf_throws @ [catch_var, wrapped]) } - }) - }) - | _ -> () - - -let connecting_string = "?" (* ? see list here http://www.fileformat.info/info/unicode/category/index.htm and here for C# http://msdn.microsoft.com/en-us/library/aa664670.aspx *) -let default_package = "java" -let strict_mode = ref false (* strict mode is so we can check for unexpected information *) - -(* reserved java words *) -let reserved = let res = Hashtbl.create 120 in - List.iter (fun lst -> Hashtbl.add res lst ("_" ^ lst)) ["abstract"; "assert"; "boolean"; "break"; "byte"; "case"; "catch"; "char"; "class"; - "const"; "continue"; "default"; "do"; "double"; "else"; "enum"; "extends"; "final"; - "false"; "finally"; "float"; "for"; "goto"; "if"; "implements"; "import"; "instanceof"; "int"; - "interface"; "long"; "native"; "new"; "null"; "package"; "private"; "protected"; "public"; "return"; "short"; - "static"; "strictfp"; "super"; "switch"; "synchronized"; "this"; "throw"; "throws"; "transient"; "true"; "try"; - "void"; "volatile"; "while"; ]; - res - -let dynamic_anon = mk_anon (ref Closed) - -let rec get_class_modifiers meta cl_type cl_access cl_modifiers = - match meta with - | [] -> cl_type,cl_access,cl_modifiers - (*| (Meta.Struct,[],_) :: meta -> get_class_modifiers meta "struct" cl_access cl_modifiers*) - | (Meta.Protected,[],_) :: meta -> get_class_modifiers meta cl_type "protected" cl_modifiers - | (Meta.Internal,[],_) :: meta -> get_class_modifiers meta cl_type "" cl_modifiers - (* no abstract for now | (":abstract",[],_) :: meta -> get_class_modifiers meta cl_type cl_access ("abstract" :: cl_modifiers) - | (Meta.Static,[],_) :: meta -> get_class_modifiers meta cl_type cl_access ("static" :: cl_modifiers) TODO: support those types *) - | _ :: meta -> get_class_modifiers meta cl_type cl_access cl_modifiers - -let rec get_fun_modifiers meta access modifiers = - match meta with - | [] -> access,modifiers - | (Meta.Protected,[],_) :: meta -> get_fun_modifiers meta "protected" modifiers - | (Meta.Internal,[],_) :: meta -> get_fun_modifiers meta "" modifiers - | (Meta.ReadOnly,[],_) :: meta -> get_fun_modifiers meta access ("final" :: modifiers) - (*| (Meta.Unsafe,[],_) :: meta -> get_fun_modifiers meta access ("unsafe" :: modifiers)*) - | (Meta.Volatile,[],_) :: meta -> get_fun_modifiers meta access ("volatile" :: modifiers) - | (Meta.Transient,[],_) :: meta -> get_fun_modifiers meta access ("transient" :: modifiers) - | (Meta.Native,[],_) :: meta -> get_fun_modifiers meta access ("native" :: modifiers) - | (Meta.NativeJni,[],_) :: meta -> get_fun_modifiers meta access ("native" :: modifiers) - | _ :: meta -> get_fun_modifiers meta access modifiers - -let generate con = - let exists = ref false in - List.iter (fun java_lib -> - if String.ends_with java_lib#get_file_path "hxjava-std.jar" then begin - exists := true; - java_lib#add_flag NativeLibraries.FlagIsStd; - end; - ) con.native_libs.java_libs; - if not !exists then - failwith "Your version of hxjava is outdated. Please update it by running: `haxelib update hxjava`"; - let gen = new_ctx con in - gen.gallow_tp_dynamic_conversion <- true; - - let basic = con.basic in - (* make the basic functions in java *) - let cl_cl = get_cl (get_type gen (["java";"lang"],"Class")) in - let basic_fns = - [ - mk_class_field "equals" (TFun(["obj",false,t_dynamic], basic.tbool)) true null_pos (Method MethNormal) []; - mk_class_field "toString" (TFun([], basic.tstring)) true null_pos (Method MethNormal) []; - mk_class_field "hashCode" (TFun([], basic.tint)) true null_pos (Method MethNormal) []; - mk_class_field "getClass" (TFun([], (TInst(cl_cl,[t_dynamic])))) true null_pos (Method MethNormal) []; - mk_class_field "wait" (TFun([], basic.tvoid)) true null_pos (Method MethNormal) []; - mk_class_field "notify" (TFun([], basic.tvoid)) true null_pos (Method MethNormal) []; - mk_class_field "notifyAll" (TFun([], basic.tvoid)) true null_pos (Method MethNormal) []; - ] in - List.iter (fun cf -> gen.gbase_class_fields <- PMap.add cf.cf_name cf gen.gbase_class_fields) basic_fns; - - (try - let native_arr_cl = get_cl ( get_type gen (["java"], "NativeArray") ) in - gen.gclasses.nativearray <- (fun t -> TInst(native_arr_cl,[t])); - gen.gclasses.nativearray_type <- (function TInst(_,[t]) -> t | _ -> die "" __LOC__); - gen.gclasses.nativearray_len <- (fun e p -> mk_field_access gen e "length" p); - - let fn_cl = get_cl (get_type gen (["haxe";"lang"],"Function")) in - - let runtime_cl = get_cl (get_type gen (["haxe";"lang"],"Runtime")) in - let nulltabstract = get_abstract (get_type gen ([],"Null")) in - - (*let string_ref = get_cl ( get_type gen (["haxe";"lang"], "StringRefl")) in*) - - let ti64 = match ( get_type gen (["java"], "Int64") ) with | TAbstractDecl a -> TAbstract(a,[]) | _ -> die "" __LOC__ in - - let has_tdynamic params = - List.exists (fun e -> match run_follow gen e with | TDynamic _ -> true | _ -> false) params - in - - (* - The type parameters always need to be changed to their boxed counterparts - *) - let change_param_type md params = - match md with - | TClassDecl( { cl_path = (["java"], "NativeArray") } ) -> params - | TAbstractDecl { a_path=[],("Class" | "Enum") } | TClassDecl { cl_path = (["java";"lang"],("Class"|"Enum")) } -> - List.map (fun _ -> t_dynamic) params - | _ -> - match params with - | [] -> [] - | _ -> - if has_tdynamic params then List.map (fun _ -> t_dynamic) params else - List.map (fun t -> - let f_t = gen.gfollow#run_f t in - match f_t with - | TAbstract ({ a_path = ([], "Bool") },[]) - | TAbstract ({ a_path = ([],"Float") },[]) - | TInst ({ cl_path = ["haxe"],"Int32" },[]) - | TInst ({ cl_path = ["haxe"],"Int64" },[]) - | TAbstract ({ a_path = ([],"Int") },[]) - | TType ({ t_path = ["java"], "Int64" },[]) - | TAbstract ({ a_path = ["java"], "Int64" },[]) - | TType ({ t_path = ["java"],"Int8" },[]) - | TAbstract ({ a_path = ["java"],"Int8" },[]) - | TType ({ t_path = ["java"],"Int16" },[]) - | TAbstract ({ a_path = ["java"],"Int16" },[]) - | TType ({ t_path = ["java"],"Char16" },[]) - | TAbstract ({ a_path = ["java"],"Char16" },[]) - | TType ({ t_path = [],"Single" },[]) - | TAbstract ({ a_path = [],"Single" },[]) -> - TAbstract(nulltabstract, [f_t]) - (*| TAbstract ({ a_path = [], "Null"*) - | TInst (cl, ((_ :: _) as p)) when cl.cl_path <> (["java"],"NativeArray") -> - (* TInst(cl, List.map (fun _ -> t_dynamic) p) *) - TInst(cl,p) - | TEnum (e, ((_ :: _) as p)) -> - TEnum(e, List.map (fun _ -> t_dynamic) p) - | _ -> t - ) params - in - - let change_clname name = - String.map (function | '$' -> '.' | c -> c) name - in - let change_id name = try Hashtbl.find reserved name with | Not_found -> name in - let change_ns ns = match ns with - | [] -> ["haxe"; "root"] - | _ -> List.map change_id ns - in - let change_field = change_id in - - let write_id w name = write w (change_id name) in - - let write_field w name = write w (change_field name) in - - gen.gfollow#add "follow_basic" PZero (fun t -> match t with - | TAbstract ({ a_path = ([], "Bool") },[]) - | TAbstract ({ a_path = ([], "Void") },[]) - | TAbstract ({ a_path = ([],"Float") },[]) - | TAbstract ({ a_path = ([],"Int") },[]) - | TInst( { cl_path = (["haxe"], "Int32") }, [] ) - | TInst( { cl_path = (["haxe"], "Int64") }, [] ) - | TType ({ t_path = ["java"], "Int64" },[]) - | TAbstract ({ a_path = ["java"], "Int64" },[]) - | TType ({ t_path = ["java"],"Int8" },[]) - | TAbstract ({ a_path = ["java"],"Int8" },[]) - | TType ({ t_path = ["java"],"Int16" },[]) - | TAbstract ({ a_path = ["java"],"Int16" },[]) - | TType ({ t_path = ["java"],"Char16" },[]) - | TAbstract ({ a_path = ["java"],"Char16" },[]) - | TType ({ t_path = [],"Single" },[]) - | TAbstract ({ a_path = [],"Single" },[]) -> - Some t - | TAbstract (({ a_path = [],"Null" } as tab),[t2]) -> - Some (TAbstract(tab,[gen.gfollow#run_f t2])) - | TType ({ t_path = ["haxe";"_Rest"],"NativeRest" } as td, [t2]) -> - Some (gen.gfollow#run_f (follow (TType (td,[get_boxed gen t2])))) - | TAbstract ({ a_path = ["haxe"],"Rest" } as a, [t2]) -> - Some (gen.gfollow#run_f ( Abstract.get_underlying_type a [get_boxed gen t2]) ) - | TAbstract (a, pl) when not (Meta.has Meta.CoreType a.a_meta) -> - Some (gen.gfollow#run_f ( Abstract.get_underlying_type a pl) ) - | TAbstract( { a_path = ([], "EnumValue") }, _ ) - | TInst( { cl_path = ([], "EnumValue") }, _ ) -> Some t_dynamic - | _ -> None); - - let change_path path = (change_ns (fst path), change_clname (snd path)) in - - let path_s path meta = try - match Meta.get Meta.JavaCanonical meta with - | (Meta.JavaCanonical, [EConst(String(pack,_)), _; EConst(String(name,_)), _], _) -> - if pack = "" then - name - else - pack ^ "." ^ name - | _ -> raise Not_found - with Not_found -> match path with - | (ns,clname) -> s_type_path (change_ns ns, change_clname clname) - in - - let cl_cl = get_cl (get_type gen (["java";"lang"],"Class")) in - - let cl_boolean = get_cl (get_type gen (["java";"lang"],"Boolean")) in - let cl_double = get_cl (get_type gen (["java";"lang"],"Double")) in - let cl_integer = get_cl (get_type gen (["java";"lang"],"Integer")) in - let cl_byte = get_cl (get_type gen (["java";"lang"],"Byte")) in - let cl_short = get_cl (get_type gen (["java";"lang"],"Short")) in - let cl_character = get_cl (get_type gen (["java";"lang"],"Character")) in - let cl_float = get_cl (get_type gen (["java";"lang"],"Float")) in - let cl_long = get_cl (get_type gen (["java";"lang"],"Long")) in - - let rec real_type t = - let t = gen.gfollow#run_f t in - match t with - | TAbstract({ a_path = ([], "Null") }, [t]) when is_java_basic_type (gen.gfollow#run_f t) -> t_dynamic - | TAbstract({ a_path = ([], "Null") }, [t]) -> ( - match gen.gfollow#run_f t with - | TAbstract( { a_path = ([], "Bool") }, [] ) -> - TInst(cl_boolean, []) - | TAbstract( { a_path = ([], "Float") }, [] ) -> - TInst(cl_double, []) - | TAbstract( { a_path = ([], "Int") }, [] ) -> - TInst(cl_integer, []) - | TAbstract( { a_path = (["java"], "Int8") }, [] ) -> - TInst(cl_byte, []) - | TAbstract( { a_path = (["java"], "Int16") }, [] ) -> - TInst(cl_short, []) - | TAbstract( { a_path = (["java"], "Char16") }, [] ) -> - TInst(cl_character, []) - | TAbstract( { a_path = ([], "Single") }, [] ) -> - TInst(cl_float, []) - | TAbstract( { a_path = (["java"], "Int64") }, [] ) - | TAbstract( { a_path = (["haxe"], "Int64") }, [] ) -> - TInst(cl_long, []) - | _ -> - real_type t - ) - | TAbstract (a, pl) when not (Meta.has Meta.CoreType a.a_meta) -> - real_type (Abstract.get_underlying_type a pl) - | TInst( { cl_path = (["haxe"], "Int32") }, [] ) -> gen.gcon.basic.tint - | TInst( { cl_path = (["haxe"], "Int64") }, [] ) -> ti64 - | TAbstract( { a_path = ([], "Class") }, p ) - | TAbstract( { a_path = ([], "Enum") }, p ) - | TInst( { cl_path = ([], "Class") }, p ) - | TInst( { cl_path = ([], "Enum") }, p ) -> TInst(cl_cl,[t_dynamic]) - | TEnum(e,params) -> TEnum(e, List.map (fun _ -> t_dynamic) params) - | TInst(c,params) when Meta.has Meta.Enum c.cl_meta -> - TInst(c, List.map (fun _ -> t_dynamic) params) - | TInst({ cl_kind = KExpr _ }, _) -> t_dynamic - | TInst _ -> t - | TType _ | TAbstract _ -> t - | TAnon (anon) -> (match !(anon.a_status) with - | ClassStatics _ | EnumStatics _ | AbstractStatics _ -> t - | _ -> t_dynamic) - | TFun _ -> TInst(fn_cl,[]) - | _ -> t_dynamic - in - - let scope = ref PMap.empty in - let imports = ref [] in - - let clear_scope () = - scope := PMap.empty; - imports := []; - in - - let add_scope name = - scope := PMap.add name () !scope - in - - let add_import pos path meta = - let name = snd path in - let rec loop = function - | (pack, n) :: _ when name = n -> - if path <> (pack,n) then - gen.gcon.error ("This expression cannot be generated because " ^ path_s path meta ^ " is shadowed by the current scope and ") pos - | _ :: tl -> - loop tl - | [] -> - (* add import *) - imports := path :: !imports - in - loop !imports - in - - let path_s_import pos path meta = match path with - | [], name when PMap.mem name !scope -> - gen.gcon.error ("This expression cannot be generated because " ^ name ^ " is shadowed by the current scope") pos; - name - | pack1 :: _, name when PMap.mem pack1 !scope -> (* exists in scope *) - add_import pos path meta; - (* check if name exists in scope *) - if PMap.mem name !scope then - gen.gcon.error ("This expression cannot be generated because " ^ pack1 ^ " and " ^ name ^ " are both shadowed by the current scope") pos; - name - | _ -> path_s path meta - in - - let is_dynamic t = match real_type t with - | TMono _ | TDynamic _ - | TInst({ cl_kind = KTypeParameter _ }, _) -> true - | TAnon anon -> - (match !(anon.a_status) with - | EnumStatics _ | ClassStatics _ | AbstractStatics _ -> false - | _ -> true - ) - | _ -> false - in - - let rec t_s stack pos t = - if List.exists (fast_eq t) stack then - path_s_import pos (["java";"lang"], "Object") [] - else begin - let stack = t :: stack in - match real_type t with - (* basic types *) - | TAbstract ({ a_path = ([], "Bool") },[]) -> "boolean" - | TAbstract ({ a_path = ([], "Void") },[]) -> - path_s_import pos (["java";"lang"], "Object") [] - | TAbstract ({ a_path = ([],"Float") },[]) -> "double" - | TAbstract ({ a_path = ([],"Int") },[]) -> "int" - | TType ({ t_path = ["java"], "Int64" },[]) - | TAbstract ({ a_path = ["java"], "Int64" },[]) -> "long" - | TType ({ t_path = ["java"],"Int8" },[]) - | TAbstract ({ a_path = ["java"],"Int8" },[]) -> "byte" - | TType ({ t_path = ["java"],"Int16" },[]) - | TAbstract ({ a_path = ["java"],"Int16" },[]) -> "short" - | TType ({ t_path = ["java"],"Char16" },[]) - | TAbstract ({ a_path = ["java"],"Char16" },[]) -> "char" - | TType ({ t_path = [],"Single" },[]) - | TAbstract ({ a_path = [],"Single" },[]) -> "float" - | TInst ({ cl_path = ["haxe"],"Int32" },[]) - | TAbstract ({ a_path = ["haxe"],"Int32" },[]) -> "int" - | TInst ({ cl_path = ["haxe"],"Int64" },[]) - | TAbstract ({ a_path = ["haxe"],"Int64" },[]) -> "long" - | TInst({ cl_path = (["java"], "NativeArray") }, [param]) -> - let rec check_t_s t = - match real_type t with - | TInst({ cl_path = (["java"], "NativeArray") }, [param]) -> - (check_t_s param) ^ "[]" - | _ -> t_s stack pos (run_follow gen t) - in - (check_t_s param) ^ "[]" - - (* end of basic types *) - | TInst ({ cl_kind = KTypeParameter _; cl_path=p }, []) -> snd p - | TAbstract ({ a_path = [], "Dynamic" },[]) -> - path_s_import pos (["java";"lang"], "Object") [] - | TMono r -> (match r.tm_type with | None -> "java.lang.Object" | Some t -> t_s stack pos (run_follow gen t)) - | TInst ({ cl_path = [], "String" }, []) -> - path_s_import pos (["java";"lang"], "String") [] - | TAbstract ({ a_path = [], "Class" }, [p]) | TAbstract ({ a_path = [], "Enum" }, [p]) - | TInst ({ cl_path = [], "Class" }, [p]) | TInst ({ cl_path = [], "Enum" }, [p]) -> - path_param_s stack pos (TClassDecl cl_cl) (["java";"lang"], "Class") [p] [] - | TAbstract ({ a_path = [], "Class" }, _) | TAbstract ({ a_path = [], "Enum" }, _) - | TInst ({ cl_path = [], "Class" }, _) | TInst ({ cl_path = [], "Enum" }, _) -> - path_s_import pos (["java";"lang"], "Class") [] - | TEnum ({e_path = p; e_meta = meta}, _) -> - path_s_import pos p meta - | TInst (({cl_path = p; cl_meta = meta} as cl), _) when Meta.has Meta.Enum cl.cl_meta -> - path_s_import pos p meta - | TInst (({cl_path = p; cl_meta = meta} as cl), params) -> (path_param_s stack pos (TClassDecl cl) p params meta) - | TType (({t_path = p; t_meta = meta} as t), params) -> (path_param_s stack pos (TTypeDecl t) p params meta) - | TAnon (anon) -> - (match !(anon.a_status) with - | ClassStatics _ | EnumStatics _ | AbstractStatics _ -> - path_s_import pos (["java";"lang"], "Class") [] - | _ -> - path_s_import pos (["java";"lang"], "Object") []) - | TDynamic _ -> - path_s_import pos (["java";"lang"], "Object") [] - (* No Lazy type nor Function type made. That's because function types will be at this point be converted into other types *) - | _ -> if !strict_mode then begin trace ("[ !TypeError " ^ (Type.s_type (Type.print_context()) t) ^ " ]"); die "" __LOC__ end else "[ !TypeError " ^ (Type.s_type (Type.print_context()) t) ^ " ]" - end - and param_t_s stack pos t = - match run_follow gen t with - | TAbstract ({ a_path = ([], "Bool") },[]) -> - path_s_import pos (["java";"lang"], "Boolean") [] - | TAbstract ({ a_path = ([],"Float") },[]) -> - path_s_import pos (["java";"lang"], "Double") [] - | TAbstract ({ a_path = ([],"Int") },[]) -> - path_s_import pos (["java";"lang"], "Integer") [] - | TType ({ t_path = ["java"], "Int64" },[]) - | TAbstract ({ a_path = ["java"], "Int64" },[]) -> - path_s_import pos (["java";"lang"], "Long") [] - | TInst ({ cl_path = ["haxe"],"Int64" },[]) - | TAbstract ({ a_path = ["haxe"],"Int64" },[]) -> - path_s_import pos (["java";"lang"], "Long") [] - | TInst ({ cl_path = ["haxe"],"Int32" },[]) - | TAbstract ({ a_path = ["haxe"],"Int32" },[]) -> - path_s_import pos (["java";"lang"], "Integer") [] - | TType ({ t_path = ["java"],"Int8" },[]) - | TAbstract ({ a_path = ["java"],"Int8" },[]) -> - path_s_import pos (["java";"lang"], "Byte") [] - | TType ({ t_path = ["java"],"Int16" },[]) - | TAbstract ({ a_path = ["java"],"Int16" },[]) -> - path_s_import pos (["java";"lang"], "Short") [] - | TType ({ t_path = ["java"],"Char16" },[]) - | TAbstract ({ a_path = ["java"],"Char16" },[]) -> - path_s_import pos (["java";"lang"], "Character") [] - | TType ({ t_path = [],"Single" },[]) - | TAbstract ({ a_path = [],"Single" },[]) -> - path_s_import pos (["java";"lang"], "Float") [] - | TDynamic _ -> "?" - | TInst (cl, params) -> t_s stack pos (TInst(cl, change_param_type (TClassDecl cl) params)) - | TType (cl, params) -> t_s stack pos (TType(cl, change_param_type (TTypeDecl cl) params)) - | TEnum (e, params) -> t_s stack pos (TEnum(e, change_param_type (TEnumDecl e) params)) - | _ -> t_s stack pos t - - and path_param_s stack pos md path params meta = - match params with - | [] -> path_s_import pos path meta - | _ when has_tdynamic (change_param_type md params) -> path_s_import pos path meta - | _ -> sprintf "%s<%s>" (path_s_import pos path meta) (String.concat ", " (List.map (fun t -> param_t_s stack pos t) (change_param_type md params))) - in - - let t_s = t_s [] - and param_t_s = param_t_s [] - and path_param_s = path_param_s [] in - - let rett_s pos t = - match t with - | TAbstract ({ a_path = ([], "Void") },[]) -> "void" - | _ -> t_s pos t - in - - let high_surrogate c = (c lsr 10) + 0xD7C0 in - let low_surrogate c = (c land 0x3FF) lor 0xDC00 in - - let escape ichar b = - match ichar with - | 92 (* \ *) -> Buffer.add_string b "\\\\" - | 39 (* ' *) -> Buffer.add_string b "\\\'" - | 34 -> Buffer.add_string b "\\\"" - | 13 (* \r *) -> Buffer.add_string b "\\r" - | 10 (* \n *) -> Buffer.add_string b "\\n" - | 9 (* \t *) -> Buffer.add_string b "\\t" - | c when c < 32 || (c >= 127 && c <= 0xFFFF) -> Buffer.add_string b (Printf.sprintf "\\u%.4x" c) - | c when c > 0xFFFF -> Buffer.add_string b (Printf.sprintf "\\u%.4x\\u%.4x" (high_surrogate c) (low_surrogate c)) - | c -> Buffer.add_char b (Char.chr c) - in - - let escape s = - let b = Buffer.create 0 in - (try - UTF8.validate s; - UTF8.iter (fun c -> escape (UCharExt.code c) b) s - with - UTF8.Malformed_code -> - String.iter (fun c -> escape (Char.code c) b) s - ); - Buffer.contents b - in - - let has_semicolon e = - match e.eexpr with - | TIdent "__fallback__" - | TCall ({ eexpr = TIdent "__lock__" }, _ ) -> false - | TBlock _ | TFor _ | TSwitch _ | TTry _ | TIf _ -> false - | TWhile (_,_,flag) when flag = Ast.NormalWhile -> false - | _ -> true - in - - let in_value = ref false in - - let md_s pos md = - let md = follow_module (gen.gfollow#run_f) md in - match md with - | TClassDecl (cl) -> - t_s pos (TInst(cl,[])) - | TEnumDecl (e) -> - t_s pos (TEnum(e,[])) - | TTypeDecl t -> - t_s pos (TType(t, [])) - | TAbstractDecl a -> - t_s pos (TAbstract(a, [])) - in - - (* - it seems that Java doesn't like when you create a new array with the type parameter defined - so we'll just ignore all type parameters, and hope for the best! - *) - let rec transform_nativearray_t t = match real_type t with - | TInst( ({ cl_path = (["java"], "NativeArray") } as narr), [t]) -> - TInst(narr, [transform_nativearray_t t]) - | TInst(cl, params) -> TInst(cl, List.map (fun _ -> t_dynamic) params) - | TEnum(e, params) -> TEnum(e, List.map (fun _ -> t_dynamic) params) - | TType(t, params) -> TType(t, List.map (fun _ -> t_dynamic) params) - | _ -> t - in - - let rec extract_tparams params el = - match el with - | ({ eexpr = TIdent "$type_param" } as tp) :: tl -> - extract_tparams (tp.etype :: params) tl - | _ -> (params, el) - in - - let line_directive = - if Common.defined gen.gcon Define.RealPosition then - fun w p -> () - else fun w p -> - let cur_line = Lexer.get_error_line p in - let file = Path.get_full_path p.pfile in - print w "//line %d \"%s\"" cur_line (StringHelper.s_escape file); newline w - in - - let extract_statements expr = - let ret = ref [] in - let rec loop expr = match expr.eexpr with - | TCall ({ eexpr = TIdent ("__is__" | "__typeof__" | "__array__")}, el) -> - List.iter loop el - | TNew ({ cl_path = (["java"], "NativeArray") }, params, [ size ]) -> - () - | TUnop (Ast.Increment, _, _) - | TUnop (Ast.Decrement, _, _) - | TBinop (Ast.OpAssign, _, _) - | TBinop (Ast.OpAssignOp _, _, _) - | TIdent "__fallback__" - | TIdent "__sbreak__" -> - ret := expr :: !ret - | TConst _ - | TLocal _ - | TIdent _ - | TArray _ - | TBinop _ - | TField _ - | TEnumParameter _ - | TTypeExpr _ - | TObjectDecl _ - | TArrayDecl _ - | TCast _ - | TParenthesis _ - | TUnop _ -> - Type.iter loop expr - | TFunction _ -> () (* do not extract parameters from inside of it *) - | _ -> - ret := expr :: !ret - in - loop expr; - (* [expr] *) - List.rev !ret - in - - let expr_s w e = - in_value := false; - let rec expr_s w e = - let was_in_value = !in_value in - in_value := true; - match e.eexpr with - | TConst c -> - (match c with - | TInt i32 -> - print w "%ld" i32; - | TFloat s -> - write w s; - (* fix for Int notation, which only fit in a Float *) - (if not (String.contains s '.' || String.contains s 'e' || String.contains s 'E') then write w ".0"); - | TString s -> print w "\"%s\"" (escape s) - | TBool b -> write w (if b then "true" else "false") - | TNull -> - (match real_type e.etype with - | TAbstract( { a_path = (["java"], "Int64") }, [] ) - | TInst( { cl_path = (["haxe"], "Int64") }, [] ) -> write w "0L" - | TInst( { cl_path = (["haxe"], "Int32") }, [] ) - | TAbstract ({ a_path = ([], "Int") },[]) -> expr_s w ({ e with eexpr = TConst(TInt Int32.zero) }) - | TAbstract ({ a_path = ([], "Float") },[]) -> expr_s w ({ e with eexpr = TConst(TFloat "0.0") }) - | TAbstract ({ a_path = ([], "Bool") },[]) -> write w "false" - | TAbstract _ when like_int e.etype -> - expr_s w (mk_cast e.etype { e with eexpr = TConst(TInt Int32.zero) }) - | TAbstract _ when like_float e.etype -> - expr_s w (mk_cast e.etype { e with eexpr = TConst(TFloat "0.0") } ) - | t -> write w ("null") ) - | TThis -> write w "this" - | TSuper -> write w "super") - | TIdent "__fallback__" -> () - | TIdent "__sbreak__" -> write w "break" - | TIdent "__undefined__" -> - write w (t_s e.epos (TInst(runtime_cl, List.map (fun _ -> t_dynamic) runtime_cl.cl_params))); - write w ".undefined"; - | TLocal var -> - write_id w var.v_name - | TIdent s -> - write_id w s - | TField(_, FEnum(en,ef)) -> - let s = ef.ef_name in - print w "%s." (path_s_import e.epos en.e_path en.e_meta); write_field w s - | TArray (e1, e2) -> - expr_s w e1; write w "["; expr_s w e2; write w "]" - | TBinop ((Ast.OpAssign as op), e1, e2) - | TBinop ((Ast.OpAssignOp _ as op), e1, e2) -> - expr_s w e1; write w ( " " ^ (Ast.s_binop op) ^ " " ); expr_s w e2 - | TBinop (op, e1, e2) -> - write w "( "; - expr_s w e1; write w ( " " ^ (Ast.s_binop op) ^ " " ); expr_s w e2; - write w " )" - | TField (e, FStatic(_, cf)) when Meta.has Meta.Native cf.cf_meta -> - let rec loop meta = match meta with - | (Meta.Native, [EConst (String(s,_)), _],_) :: _ -> - expr_s w e; write w "."; write_field w s - | _ :: tl -> loop tl - | [] -> expr_s w e; write w "."; write_field w (cf.cf_name) - in - loop cf.cf_meta - | TField (e, s) -> - expr_s w e; write w "."; write_field w (field_name s) - | TTypeExpr (TClassDecl { cl_path = (["haxe"], "Int32") }) -> - write w (path_s_import e.epos (["haxe"], "Int32") []) - | TTypeExpr (TClassDecl { cl_path = (["haxe"], "Int64") }) -> - write w (path_s_import e.epos (["haxe"], "Int64") []) - | TTypeExpr mt -> write w (md_s e.epos mt) - | TParenthesis e -> - write w "("; expr_s w e; write w ")" - | TMeta ((Meta.LoopLabel,[(EConst(Int (n, _)),_)],_), e) -> - (match e.eexpr with - | TFor _ | TWhile _ -> - print w "label%s:" n; - newline w; - expr_s w e; - | TBreak -> print w "break label%s" n - | _ -> die "" __LOC__) - | TMeta (_,e) -> - expr_s w e - | TCall ({ eexpr = TField(_, FStatic({ cl_path = (["haxe";"_Rest"],"Rest_Impl_") }, { cf_name = "createNative" })) }, el) -> - (match follow e.etype with - | TInst (cls, params) -> - expr_s w { e with eexpr = TNew(cls,params,el) } - | _ -> die ~p:e.epos "Unexpected return type of haxe.Rest.createNative" __LOC__) - | TCall ({ eexpr = TIdent "__array__" }, el) - | TCall ({ eexpr = TField(_, FStatic({ cl_path = (["java"],"NativeArray") }, { cf_name = "make" })) }, el) - | TArrayDecl el when t_has_type_param e.etype -> - let _, el = extract_tparams [] el in - print w "( (%s) (new %s " (t_s e.epos e.etype) (t_s e.epos (replace_type_param e.etype)); - write w "{"; - ignore (List.fold_left (fun acc e -> - (if acc <> 0 then write w ", "); - expr_s w e; - acc + 1 - ) 0 el); - write w "}) )" - | TCall ({ eexpr = TIdent "__array__" }, el) - | TCall ({ eexpr = TField(_, FStatic({ cl_path = (["java"],"NativeArray") }, { cf_name = "make" })) }, el) - | TArrayDecl el -> - let _, el = extract_tparams [] el in - print w "new %s" (param_t_s e.epos (transform_nativearray_t e.etype)); - let is_double = match follow e.etype with - | TInst(_,[ t ]) -> if like_float t && not (like_int t) then Some t else None - | _ -> None - in - - write w "{"; - ignore (List.fold_left (fun acc e -> - (if acc <> 0 then write w ", "); - (* this is a hack so we are able to convert ints to boxed Double / Float when needed *) - let e = if is_some is_double then mk_cast (get is_double) e else e in - - expr_s w e; - acc + 1 - ) 0 el); - write w "}" - | TCall( ( { eexpr = TField(_, FStatic({ cl_path = ([], "String") }, { cf_name = "fromCharCode" })) } ), [cc] ) -> - write w "new java.lang.String( java.lang.Character.toChars((int) "; - expr_s w cc; - write w ") )" - | TCall ({ eexpr = TIdent "__is__" }, [ expr; { eexpr = TTypeExpr(md) } ] ) -> - write w "( "; - expr_s w expr; - write w " instanceof "; - write w (md_s e.epos md); - write w " )" - | TCall ({ eexpr = TIdent "__java__" }, [ { eexpr = TConst(TString(s)) } ] ) -> - write w s - | TCall ({ eexpr = TIdent "__java__" }, { eexpr = TConst(TString(s)) } :: tl ) -> - Codegen.interpolate_code gen.gcon s tl (write w) (expr_s w) e.epos - | TCall ({ eexpr = TIdent "__lock__" }, [ eobj; eblock ] ) -> - write w "synchronized("; - let rec loop eobj = match eobj.eexpr with - | TTypeExpr md -> - expr_s w eobj; - write w ".class" - | TMeta(_,e) | TParenthesis(e) -> - loop e - | _ -> - expr_s w eobj - in - loop eobj; - write w ")"; - (match eblock.eexpr with - | TBlock(_ :: _) -> - expr_s w eblock - | _ -> - begin_block w; - expr_s w eblock; - if has_semicolon eblock then write w ";"; - end_block w; - ) - | TCall ({ eexpr = TIdent "__typeof__" }, [ { eexpr = TTypeExpr md } as expr ] ) -> - expr_s w expr; - write w ".class" - | TCall (e, el) -> - let params, el = extract_tparams [] el in - - expr_s w e; - - (*(match params with - | [] -> () - | params -> - let md = match e.eexpr with - | TField(ef, _) -> t_to_md (run_follow gen ef.etype) - | _ -> die "" __LOC__ - in - write w "<"; - ignore (List.fold_left (fun acc t -> - (if acc <> 0 then write w ", "); - write w (param_t_s (change_param_type md t)); - acc + 1 - ) 0 params); - write w ">" - );*) - - write w "("; - ignore (List.fold_left (fun acc e -> - (if acc <> 0 then write w ", "); - expr_s w e; - acc + 1 - ) 0 el); - write w ")" - | TNew (({ cl_path = (["java"], "NativeArray") } as cl), params, [ size ]) -> - let rec check_t_s t times = - match real_type t with - | TInst({ cl_path = (["java"], "NativeArray") }, [param]) -> - (check_t_s param (times+1)) - | _ -> - print w "new %s[" (t_s e.epos (transform_nativearray_t t)); - expr_s w size; - print w "]"; - let rec loop i = - if i <= 0 then () else (write w "[]"; loop (i-1)) - in - loop (times - 1) - in - check_t_s (TInst(cl, params)) 0 - | TNew ({ cl_path = ([], "String") } as cl, [], el) -> - write w "new "; - write w (t_s e.epos (TInst(cl, []))); - write w "("; - ignore (List.fold_left (fun acc e -> - (if acc <> 0 then write w ", "); - expr_s w e; - acc + 1 - ) 0 el); - write w ")" - | TNew ({ cl_kind = KTypeParameter _ } as cl, params, el) -> - print w "null /* This code should never be reached. It was produced by the use of @:generic on a new type parameter instance: %s */" (path_param_s e.epos (TClassDecl cl) cl.cl_path params cl.cl_meta) - | TNew (cl, params, el) -> - write w "new "; - write w (path_param_s e.epos (TClassDecl cl) cl.cl_path params cl.cl_meta); - write w "("; - ignore (List.fold_left (fun acc e -> - (if acc <> 0 then write w ", "); - expr_s w e; - acc + 1 - ) 0 el); - write w ")" - | TUnop (Ast.Spread, Prefix, e) -> expr_s w e - | TUnop ((Ast.Increment as op), flag, e) - | TUnop ((Ast.Decrement as op), flag, e) -> - (match flag with - | Ast.Prefix -> write w ( " " ^ (Ast.s_unop op) ^ " " ); expr_s w e - | Ast.Postfix -> expr_s w e; write w (Ast.s_unop op)) - | TUnop (op, flag, e) -> - (match flag with - | Ast.Prefix -> write w ( " " ^ (Ast.s_unop op) ^ " (" ); expr_s w e; write w ") " - | Ast.Postfix -> write w "("; expr_s w e; write w (") " ^ Ast.s_unop op)) - | TVar (var, eopt) -> - print w "%s " (t_s e.epos var.v_type); - write_id w var.v_name; - (match eopt with - | None -> - write w " = "; - expr_s w (null var.v_type e.epos) - | Some e -> - write w " = "; - expr_s w e - ) - | TBlock [e] when was_in_value -> - expr_s w e - | TBlock el -> - begin_block w; - List.iter (fun e -> - List.iter (fun e -> - in_value := false; - line_directive w e.epos; - expr_s w e; - if has_semicolon e then write w ";"; - newline w; - ) (extract_statements e) - ) el; - end_block w - | TIf (econd, e1, Some(eelse)) when was_in_value -> - write w "( "; - expr_s w (mk_paren econd); - write w " ? "; - expr_s w (mk_paren e1); - write w " : "; - expr_s w (mk_paren eelse); - write w " )"; - | TIf (econd, e1, eelse) -> - write w "if "; - expr_s w (mk_paren econd); - write w " "; - in_value := false; - expr_s w (mk_block e1); - (match eelse with - | None -> () - | Some e -> - write w "else"; - in_value := false; - expr_s w (mk_block e) - ) - | TWhile (econd, eblock, flag) -> - (match flag with - | Ast.NormalWhile -> - write w "while "; - expr_s w (mk_paren econd); - write w ""; - in_value := false; - expr_s w (mk_block eblock) - | Ast.DoWhile -> - write w "do "; - in_value := false; - expr_s w (mk_block eblock); - write w "while "; - in_value := true; - expr_s w (mk_paren econd); - ) - | TSwitch switch -> - write w "switch "; - expr_s w (mk_paren switch.switch_subject); - begin_block w; - List.iter (fun {case_patterns = el;case_expr = e} -> - List.iter (fun e -> - write w "case "; - in_value := true; - (match e.eexpr with - | TField(_, FEnum(e, ef)) -> - let changed_name = change_id ef.ef_name in - write w changed_name - | _ -> - expr_s w e); - write w ":"; - newline w; - ) el; - in_value := false; - expr_s w (mk_block e); - newline w; - newline w - ) switch.switch_cases; - if is_some switch.switch_default then begin - write w "default:"; - newline w; - in_value := false; - expr_s w (get switch.switch_default); - newline w; - end; - end_block w - | TTry (tryexpr, ve_l) -> - write w "try "; - in_value := false; - expr_s w (mk_block tryexpr); - let pos = e.epos in - List.iter (fun (var, e) -> - print w "catch (%s %s)" (t_s pos var.v_type) (var.v_name); - in_value := false; - expr_s w (mk_block e); - newline w - ) ve_l - | TReturn eopt -> - write w "return "; - if is_some eopt then expr_s w (get eopt) - | TBreak -> write w "break" - | TContinue -> write w "continue" - | TThrow e -> - write w "throw "; - expr_s w e - | TCast (e1,md_t) -> - ((*match gen.gfollow#run_f e.etype with - | TType({ t_path = ([], "UInt") }, []) -> - write w "( unchecked ((uint) "; - expr_s w e1; - write w ") )" - | _ ->*) - (* FIXME I'm ignoring module type *) - print w "((%s) (" (t_s e.epos e.etype); - expr_s w e1; - write w ") )" - ) - | TFor (_,_,content) -> - write w "[ for not supported "; - expr_s w content; - write w " ]"; - if !strict_mode then die "" __LOC__ - | TObjectDecl _ -> write w "[ obj decl not supported ]"; if !strict_mode then die "" __LOC__ - | TFunction _ -> write w "[ func decl not supported ]"; if !strict_mode then die "" __LOC__ - | TEnumParameter _ -> write w "[ enum parameter not supported ]"; if !strict_mode then die "" __LOC__ - | TEnumIndex _ -> write w "[ enum index not supported ]"; if !strict_mode then die "" __LOC__ - in - expr_s w e - in - - let rec gen_fpart_attrib w = function - | EConst( Ident i ), _ -> - write w i - | EField( ef, f, _ ), _ -> - gen_fpart_attrib w ef; - write w "."; - write w f - | _, p -> - gen.gcon.error "Invalid expression inside @:meta metadata" p - in - - let rec gen_spart w = function - | EConst c, p -> (match c with - | Int (s, _) | Float (s, _) | Ident s -> - write w s - | String(s,_) -> - write w "\""; - write w (escape s); - write w "\"" - | _ -> gen.gcon.error "Invalid expression inside @:meta metadata" p) - | EField( ef, f, _ ), _ -> - gen_spart w ef; - write w "."; - write w f - | EBinop( Ast.OpAssign, (EConst (Ident s), _), e2 ), _ -> - write w s; - write w " = "; - gen_spart w e2 - | EArrayDecl( el ), _ -> - write w "{"; - let fst = ref true in - List.iter (fun e -> - if !fst then fst := false else write w ", "; - gen_spart w e - ) el; - write w "}" - | ECall(fpart,args), _ -> - gen_fpart_attrib w fpart; - write w "("; - let fst = ref true in - List.iter (fun e -> - if !fst then fst := false else write w ", "; - gen_spart w e - ) args; - write w ")" - | _, p -> - gen.gcon.error "Invalid expression inside @:meta metadata" p - in - - let gen_annotations w ?(add_newline=true) metadata = - List.iter (function - | Meta.Meta, [meta], _ -> - write w "@"; - gen_spart w meta; - if add_newline then newline w else write w " "; - | _ -> () - ) metadata - in - - let argt_s p t = - let w = new_source_writer () in - let rec run t = - match t with - | TType (tdef,p) -> - gen_annotations w ~add_newline:false tdef.t_meta; - run (follow_once t) - | TMono r -> - (match r.tm_type with - | Some t -> run t - | _ -> () (* avoid infinite loop / should be the same in this context *)) - | TLazy f -> - run (lazy_type f) - | _ -> () - in - run t; - let ret = t_s p t in - let c = contents w in - if c <> "" then - c ^ " " ^ ret - else - ret - in - - let get_string_params cl_params = - match cl_params with - | [] -> - ("","") - | _ -> - let params = sprintf "<%s>" (String.concat ", " (List.map (fun tp -> snd tp.ttp_class.cl_path) cl_params)) in - (params, "") - in - - let write_parts w parts = - let parts = List.filter (fun s -> s <> "") parts in - write w (String.concat " " parts) - in - - let rec gen_class_field w ?(is_overload=false) is_static cl is_final cf = - let is_interface = (has_class_flag cl CInterface) in - let name, is_new, is_explicit_iface = match cf.cf_name with - | "new" -> snd cl.cl_path, true, false - | name when String.contains name '.' -> - let fn_name, path = parse_explicit_iface name in - (path_s path cl.cl_meta) ^ "." ^ fn_name, false, true - | name -> name, false, false - in - (match cf.cf_kind with - | Var _ - | Method (MethDynamic) when Type.is_physical_field cf -> - (if is_overload || List.exists (fun cf -> cf.cf_expr <> None) cf.cf_overloads then - gen.gcon.error "Only normal (non-dynamic) methods can be overloaded" cf.cf_pos); - if not is_interface then begin - let access, modifiers = get_fun_modifiers cf.cf_meta "public" [] in - write_parts w (access :: (if is_static then "static" else "") :: modifiers @ [(t_s cf.cf_pos (run_follow gen cf.cf_type)); (change_field name)]); - (match cf.cf_expr with - | Some e -> - write w " = "; - expr_s w e; - write w ";" - | None -> write w ";" - ) - end (* TODO see how (get,set) variable handle when they are interfaces *) - | Method _ when not (Type.is_physical_field cf) || (match cl.cl_kind, cf.cf_expr with | KAbstractImpl _, None -> true | _ -> false) -> - List.iter (fun cf -> if (has_class_flag cl CInterface) || cf.cf_expr <> None then - gen_class_field w ~is_overload:true is_static cl (has_class_field_flag cf CfFinal) cf - ) cf.cf_overloads - | Var _ | Method MethDynamic -> () - | Method mkind -> - List.iter (fun cf -> - if (has_class_flag cl CInterface) || (has_class_flag cl CAbstract) || cf.cf_expr <> None then - gen_class_field w ~is_overload:true is_static cl (has_class_field_flag cf CfFinal) cf - ) cf.cf_overloads; - let is_virtual = is_new || (not is_final && match mkind with | MethInline -> false | _ when not is_new -> true | _ -> false) in - let is_override = match cf.cf_name with - | "equals" when not is_static -> - (match cf.cf_type with - | TFun([_,_,t], ret) -> - (match (real_type t, real_type ret) with - | TDynamic _, TAbstract ({ a_path = ([], "Bool") },[]) - | TAnon _, TAbstract ({ a_path = ([], "Bool") },[]) -> true - | _ -> has_class_field_flag cf CfOverride - ) - | _ -> has_class_field_flag cf CfOverride) - | "toString" when not is_static -> - (match cf.cf_type with - | TFun([], ret) -> - (match real_type ret with - | TInst( { cl_path = ([], "String") }, []) -> true - | _ -> gen.gcon.error "A toString() function should return a String!" cf.cf_pos; false - ) - | _ -> has_class_field_flag cf CfOverride - ) - | "hashCode" when not is_static -> - (match cf.cf_type with - | TFun([], ret) -> - (match real_type ret with - | TAbstract ({ a_path = ([], "Int") },[]) -> - true - | _ -> gen.gcon.error "A hashCode() function should return an Int!" cf.cf_pos; false - ) - | _ -> has_class_field_flag cf CfOverride - ) - | _ -> has_class_field_flag cf CfOverride - in - let visibility = if is_interface then "" else "public" in - - let visibility, modifiers = get_fun_modifiers cf.cf_meta visibility [] in - let is_abstract = has_class_field_flag cf CfAbstract in - let modifiers = if is_abstract then "abstract" :: modifiers else modifiers in - let visibility, is_virtual = if is_explicit_iface then "",false else visibility, is_virtual in - let v_n = if is_static then "static" else if is_override && not is_interface then "" else if not is_virtual then "final" else "" in - let cf_type = if is_override && not is_overload && not (has_class_field_flag cf CfOverload) then match field_access gen (TInst(cl, extract_param_types cl.cl_params)) cf.cf_name with | FClassField(_,_,_,_,_,actual_t,_) -> actual_t | _ -> die "" __LOC__ else cf.cf_type in - - let params = extract_param_types cl.cl_params in - let ret_type, args, has_rest_args = match follow cf_type, follow cf.cf_type with - | TFun (strbtl, t), TFun(rargs, _) -> - let ret_type = apply_params cl.cl_params params (real_type t) - and args = - List.map2 (fun(_,_,t) (n,o,_) -> - (n,o,apply_params cl.cl_params params (real_type t)) - ) strbtl rargs - and rest = - match List.rev rargs with - | (_,_,t) :: _ -> ExtType.is_rest (follow t) - | _ -> false - in - ret_type,args,rest - | _ -> die "" __LOC__ - in - - (if is_override && not is_interface then write w "@Override "); - gen_annotations w cf.cf_meta; - (* public static void funcName *) - let params, _ = get_string_params cf.cf_params in - - write_parts w (visibility :: v_n :: modifiers @ [params; (if is_new then "" else rett_s cf.cf_pos (run_follow gen ret_type)); (change_field name)]); - - (* (string arg1, object arg2) with T : object *) - let arg_names = - match cf.cf_expr with - | Some { eexpr = TFunction tf } -> - List.map (fun (var,_) -> change_id var.v_name) tf.tf_args - | _ -> - List.map (fun (name,_,_) -> change_id name) args - in - let rec loop acc names args = - match names, args with - | [], [] -> acc - | _, [] | [], _ -> - die "" __LOC__ - | [name], [_,_,TInst ({ cl_path = ["java"],"NativeArray" }, [t])] when has_rest_args -> - let arg = sprintf "%s ...%s" (argt_s cf.cf_pos (run_follow gen t)) name in - arg :: acc - | name :: names, (_,_,t) :: args -> - let arg = sprintf "%s %s" (argt_s cf.cf_pos (run_follow gen t)) name in - loop (arg :: acc) names args - in - print w "(%s)" (String.concat ", " (List.rev (loop [] arg_names args))); - if is_interface || List.mem "native" modifiers || is_abstract then - write w ";" - else begin - let rec loop meta = - match meta with - | [] -> - let expr = match cf.cf_expr with - | None -> mk (TBlock([])) t_dynamic null_pos - | Some s -> - match s.eexpr with - | TFunction tf -> - mk_block (tf.tf_expr) - | _ -> die "" __LOC__ (* FIXME *) - in - (if is_new then begin - (*let rec get_super_call el = - match el with - | ( { eexpr = TCall( { eexpr = TConst(TSuper) }, _) } as call) :: rest -> - Some call, rest - | ( { eexpr = TBlock(bl) } as block ) :: rest -> - let ret, mapped = get_super_call bl in - ret, ( { block with eexpr = TBlock(mapped) } :: rest ) - | _ -> - None, el - in*) - expr_s w expr - end else begin - expr_s w expr; - end) - | (Meta.Throws, [Ast.EConst (Ast.String(t,_)), _], _) :: tl -> - print w " throws %s" t; - loop tl - | (Meta.FunctionCode, [Ast.EConst (Ast.String(contents,_)),_],_) :: tl -> - begin_block w; - write w contents; - end_block w - | _ :: tl -> loop tl - in - loop cf.cf_meta - - end); - newline w; - newline w - in - - let gen_class_field w ?(is_overload=false) is_static cl is_final cf = - (* This should probably be handled somewhere earlier in the unholy gencommon machinery, but whatever *) - if not (has_class_field_flag cf CfExtern) then gen_class_field w ~is_overload is_static cl is_final cf - in - - let gen_class w cl = - let cf_filters = [ handle_throws ] in - List.iter (fun f -> List.iter (f gen) cl.cl_ordered_fields) cf_filters; - List.iter (fun f -> List.iter (f gen) cl.cl_ordered_statics) cf_filters; - let should_close = match change_ns (fst cl.cl_path) with - | [] -> false - | ns -> - print w "package %s;" (String.concat "." (change_ns ns)); - newline w; - newline w; - false - in - - let rec loop_meta meta acc = - match meta with - | (Meta.SuppressWarnings, [Ast.EConst (Ast.String(w,_)),_],_) :: meta -> loop_meta meta (w :: acc) - | _ :: meta -> loop_meta meta acc - | _ -> acc - in - - let suppress_warnings = loop_meta cl.cl_meta [ "rawtypes"; "unchecked" ] in - - write w "import haxe.root.*;"; - newline w; - let w_header = w in - let w = new_source_writer () in - clear_scope(); - - (* add all haxe.root.* to imports *) - List.iter (function - | TClassDecl { cl_path = ([],c) } -> - imports := ([],c) :: !imports - | TEnumDecl { e_path = ([],c) } -> - imports := ([],c) :: !imports - | TAbstractDecl { a_path = ([],c) } -> - imports := ([],c) :: !imports - | _ -> () - ) gen.gtypes_list; - - newline w; - write w "@SuppressWarnings(value={"; - let first = ref true in - List.iter (fun s -> - (if !first then first := false else write w ", "); - print w "\"%s\"" (escape s) - ) suppress_warnings; - write w "})"; - newline w; - gen_annotations w cl.cl_meta; - - let clt, access, modifiers = get_class_modifiers cl.cl_meta (if (has_class_flag cl CInterface) then "interface" else "class") "public" [] in - let is_final = has_class_flag cl CFinal in - let is_abstract = has_class_flag cl CAbstract in - let modifiers = if is_final then "final" :: modifiers else modifiers in - let modifiers = if is_abstract then "abstract" :: modifiers else modifiers in - - write_parts w (access :: modifiers @ [clt; (change_clname (snd cl.cl_path))]); - - (* type parameters *) - let params, _ = get_string_params cl.cl_params in - let cl_p_to_string (c,p) = - let p = List.map (fun t -> match follow t with - | TMono _ | TDynamic _ -> t_empty - | _ -> t) p - in - path_param_s cl.cl_pos (TClassDecl c) c.cl_path p c.cl_meta - in - print w "%s" params; - (if is_some cl.cl_super then print w " extends %s" (cl_p_to_string (get cl.cl_super))); - (match cl.cl_implements with - | [] -> () - | _ -> print w " %s %s" (if (has_class_flag cl CInterface) then "extends" else "implements") (String.concat ", " (List.map cl_p_to_string cl.cl_implements)) - ); - (* class head ok: *) - (* public class Test : X, Y, Z where A : Y *) - begin_block w; - (* our constructor is expected to be a normal "new" function * - if !strict_mode && is_some cl.cl_constructor then die "" __LOC__;*) - - let rec loop cl = - List.iter (fun cf -> add_scope cf.cf_name) cl.cl_ordered_fields; - List.iter (fun cf -> add_scope cf.cf_name) cl.cl_ordered_statics; - match cl.cl_super with - | Some(c,_) -> loop c - | None -> () - in - loop cl; - - let rec loop meta = - match meta with - | [] -> () - | (Meta.ClassCode, [Ast.EConst (Ast.String(contents,_)),_],_) :: tl -> - write w contents - | _ :: tl -> loop tl - in - loop cl.cl_meta; - - (match gen.gentry_point with - | Some (_,cl_main,expr) when cl == cl_main -> - write w "public static void main(String[] args)"; - begin_block w; - (try - let t = Hashtbl.find gen.gtypes ([], "Sys") in - match t with - | TClassDecl(cl) when PMap.mem "_args" cl.cl_statics -> - write w "Sys._args = args;"; newline w - | _ -> () - with Not_found -> - ()); - write w "haxe.java.Init.init();"; - newline w; - expr_s w expr; - write w ";"; - end_block w; - newline w - | _ -> ()); - - (match TClass.get_cl_init cl with - | None -> () - | Some init -> - write w "static"; - expr_s w (mk_block init); - newline w - ); - - (if is_some cl.cl_constructor then gen_class_field w false cl is_final (get cl.cl_constructor)); - (if not (has_class_flag cl CInterface) then List.iter (gen_class_field w true cl is_final) cl.cl_ordered_statics); - List.iter (gen_class_field w false cl is_final) cl.cl_ordered_fields; - - end_block w; - if should_close then end_block w; - - (* add imports *) - List.iter (function - | ["haxe";"root"], _ | [], _ -> () - | path -> - write w_header "import "; - write w_header (path_s path []); - write w_header ";\n" - ) !imports; - add_writer w w_header - in - - - let gen_enum w e = - let should_close = match change_ns (fst e.e_path) with - | [] -> false - | ns -> - print w "package %s;" (String.concat "." (change_ns ns)); - newline w; - newline w; - false - in - - gen_annotations w e.e_meta; - print w "public enum %s" (change_clname (snd e.e_path)); - begin_block w; - write w (String.concat ", " (List.map (change_id) e.e_names)); - end_block w; - - if should_close then end_block w - in - - let module_type_gen w md_tp = - Codegen.map_source_header gen.gcon (fun s -> print w "// %s\n" s); - match md_tp with - | TClassDecl cl -> - if not (has_class_flag cl CExtern) then begin - gen_class w cl; - newline w; - newline w - end; - (not (has_class_flag cl CExtern)) - | TEnumDecl e -> - if not e.e_extern && not (Meta.has Meta.Class e.e_meta) then begin - gen_enum w e; - newline w; - newline w - end; - (not e.e_extern) - | TTypeDecl e -> - false - | TAbstractDecl a -> - false - in - - (* generate source code *) - init_ctx gen; - - Hashtbl.add gen.gspecial_vars "__is__" true; - Hashtbl.add gen.gspecial_vars "__typeof__" true; - Hashtbl.add gen.gspecial_vars "__java__" true; - Hashtbl.add gen.gspecial_vars "__lock__" true; - Hashtbl.add gen.gspecial_vars "__array__" true; - - gen.greal_type <- real_type; - gen.greal_type_param <- change_param_type; - gen.gspecial_needs_cast <- (fun to_t from_t -> - is_boxed_of_t to_t from_t || - is_boxed_of_t from_t to_t || - ( (is_boxed_int_type from_t || is_boxed_float_type from_t ) && - (is_boxed_int_type to_t || is_boxed_float_type to_t || is_int_type to_t || is_float_type to_t) ) || - ( (is_boxed_int_type to_t || is_boxed_float_type to_t ) && - (is_boxed_int_type from_t || is_boxed_float_type from_t || is_int_type from_t || is_float_type from_t) ) - ); - - (* before running the filters, follow all possible types *) - (* this is needed so our module transformations don't break some core features *) - (* like multitype selection *) - let run_follow_gen = run_follow gen in - let rec type_map e = Type.map_expr_type (fun e->type_map e) (run_follow_gen) (fun tvar-> tvar.v_type <- (run_follow_gen tvar.v_type); tvar) e in - 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 @ (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_super <- Option.map super_map cl.cl_super; - cl.cl_implements <- List.map super_map cl.cl_implements - | _ -> () - ) gen.gtypes_list; - - let get_vmtype t = match real_type t with - | TInst({ cl_path = ["java"],"NativeArray" }, tl) -> t - | TInst(c,tl) -> TInst(c,List.map (fun _ -> t_dynamic) tl) - | TEnum(e,tl) -> TEnum(e, List.map (fun _ -> t_dynamic) tl) - | TType(t,tl) -> TType(t, List.map (fun _ -> t_dynamic) tl) - | TAbstract(a,tl) -> TAbstract(a, List.map (fun _ -> t_dynamic) tl) - | t -> t - in - - FixOverrides.configure ~get_vmtype gen; - - let allowed_meta = Hashtbl.create 1 in - Hashtbl.add allowed_meta Meta.LoopLabel true; - Normalize.configure gen ~allowed_metas:allowed_meta; - - AbstractImplementationFix.configure gen; - - let cl_arg_exc = get_cl (get_type gen (["java";"lang"],"IllegalArgumentException")) in - let cl_arg_exc_t = TInst (cl_arg_exc, []) in - let mk_arg_exception msg pos = mk (TNew (cl_arg_exc, [], [Texpr.Builder.make_string gen.gcon.basic msg pos])) cl_arg_exc_t pos in - let closure_t = ClosuresToClass.DoubleAndDynamicClosureImpl.get_ctx gen (get_cl (get_type gen (["haxe";"lang"],"Function"))) 6 mk_arg_exception in - ClosuresToClass.configure gen closure_t; - - let enum_base = (get_cl (get_type gen (["haxe";"lang"],"Enum")) ) in - let param_enum_base = (get_cl (get_type gen (["haxe";"lang"],"ParamEnum")) ) in - let type_enumindex = mk_static_field_access_infer gen.gclasses.cl_type "enumIndex" null_pos [] in - let mk_enum_index_call e p = - mk (TCall (type_enumindex, [e])) gen.gcon.basic.tint p - in - EnumToClass.configure gen false true enum_base param_enum_base mk_enum_index_call; - - InterfaceVarsDeleteModf.configure gen; - - let dynamic_object = (get_cl (get_type gen (["haxe";"lang"],"DynamicObject")) ) in - - let object_iface = get_cl (get_type gen (["haxe";"lang"],"IHxObject")) in - - let empty_en = match get_type gen (["haxe";"lang"], "EmptyObject") with TEnumDecl e -> e | _ -> die "" __LOC__ in - let empty_ctor_type = TEnum(empty_en, []) in - let empty_en_expr = mk (TTypeExpr (TEnumDecl empty_en)) (mk_anon (ref (EnumStatics empty_en))) null_pos in - let empty_ctor_expr = mk (TField (empty_en_expr, FEnum(empty_en, PMap.find "EMPTY" empty_en.e_constrs))) empty_ctor_type null_pos in - OverloadingConstructor.configure ~empty_ctor_type:empty_ctor_type ~empty_ctor_expr:empty_ctor_expr gen; - - let rcf_static_find = mk_static_field_access_infer (get_cl (get_type gen (["haxe";"lang"], "FieldLookup"))) "findHash" null_pos [] in - (*let rcf_static_lookup = mk_static_field_access_infer (get_cl (get_type gen (["haxe";"lang"], "FieldLookup"))) "lookupHash" null_pos [] in*) - let get_specialized_postfix t = match t with - | TAbstract({a_path = [],"Float"}, _) -> "Float" - | TInst({cl_path = [],"String"},_) -> "String" - | TAnon _ | TDynamic _ -> "Dynamic" - | _ -> print_endline (debug_type t); die "" __LOC__ - in - let rcf_static_insert t = mk_static_field_access_infer (get_cl (get_type gen (["haxe";"lang"], "FieldLookup"))) ("insert" ^ get_specialized_postfix t) null_pos [] in - let rcf_static_remove t = mk_static_field_access_infer (get_cl (get_type gen (["haxe";"lang"], "FieldLookup"))) ("remove" ^ get_specialized_postfix t) null_pos [] in - - let can_be_float t = like_float (real_type t) in - - let rcf_on_getset_field main_expr field_expr field may_hash may_set is_unsafe = - let is_float = can_be_float (if is_none may_set then main_expr.etype else (get may_set).etype) in - let fn_name = if is_some may_set then "setField" else "getField" in - let fn_name = if is_float then fn_name ^ "_f" else fn_name in - let pos = field_expr.epos in - - let is_unsafe = { eexpr = TConst(TBool is_unsafe); etype = basic.tbool; epos = pos } in - - let should_cast = match main_expr.etype with | TAbstract({ a_path = ([], "Float") }, []) -> false | _ -> true in - let infer = mk_static_field_access_infer runtime_cl fn_name field_expr.epos [] in - let first_args = - [ field_expr; { eexpr = TConst(TString field); etype = basic.tstring; epos = pos } ] - @ if is_some may_hash then [ { eexpr = TConst(TInt (get may_hash)); etype = basic.tint; epos = pos } ] else [] - in - let args = first_args @ match is_float, may_set with - | true, Some(set) -> - [ if should_cast then mk_cast basic.tfloat set else set ] - | false, Some(set) -> - [ set ] - | _ -> - [ is_unsafe ] - in - - let call = { main_expr with eexpr = TCall(infer,args) } in - let call = if is_float && should_cast then mk_cast main_expr.etype call else call in - call - in - - let rcf_on_call_field ecall field_expr field may_hash args = - let infer = mk_static_field_access_infer runtime_cl "callField" field_expr.epos [] in - - let hash_arg = match may_hash with - | None -> [] - | Some h -> [ { eexpr = TConst(TInt h); etype = basic.tint; epos = field_expr.epos } ] - in - - let arr_call = if args <> [] then - mk_nativearray_decl gen t_dynamic args ecall.epos - else - null (gen.gclasses.nativearray t_dynamic) ecall.epos - in - - - let call_args = - [field_expr; { field_expr with eexpr = TConst(TString field); etype = basic.tstring } ] - @ hash_arg - @ [ arr_call ] - in - - mk_cast ecall.etype { ecall with eexpr = TCall(infer, call_args); etype = t_dynamic } - in - - let cl_field_exc = get_cl (get_type gen (["java";"lang"],"RuntimeException")) in - let cl_field_exc_t = TInst (cl_field_exc, []) in - let mk_field_exception msg pos = mk (TNew (cl_field_exc, [], [Texpr.Builder.make_string gen.gcon.basic msg pos])) cl_field_exc_t pos in - - let rcf_ctx = - ReflectionCFs.new_ctx - gen - closure_t - object_iface - false - rcf_on_getset_field - rcf_on_call_field - (fun hash hash_array length -> { hash with eexpr = TCall(rcf_static_find, [hash; hash_array; length]); etype=basic.tint }) - (fun hash -> hash) - (fun hash_array length pos value -> - { hash_array with - eexpr = TBinop(OpAssign, - hash_array, - mk (TCall(rcf_static_insert value.etype, [hash_array; length; pos; value])) hash_array.etype hash_array.epos) - }) - (fun hash_array length pos -> - let t = gen.gclasses.nativearray_type hash_array.etype in - { hash_array with eexpr = TCall(rcf_static_remove t, [hash_array; length; pos]); etype = gen.gcon.basic.tvoid } - ) - None - mk_field_exception - in - - ReflectionCFs.UniversalBaseClass.configure gen (get_cl (get_type gen (["haxe";"lang"],"HxObject")) ) object_iface dynamic_object; - - ReflectionCFs.configure_dynamic_field_access rcf_ctx; - - ReflectionCFs.implement_varargs_cl rcf_ctx ( get_cl (get_type gen (["haxe";"lang"], "VarArgsBase")) ); - - let slow_invoke_field = mk_static_field_access_infer runtime_cl "slowCallField" null_pos [] in - let slow_invoke ethis efield eargs = - mk (TCall (slow_invoke_field, [ethis; efield; eargs])) t_dynamic ethis.epos - in - ReflectionCFs.configure rcf_ctx ~slow_invoke:slow_invoke object_iface; - - ObjectDeclMap.configure gen (ReflectionCFs.implement_dynamic_object_ctor rcf_ctx dynamic_object); - - InitFunction.configure gen; - TArrayTransform.configure gen ( - fun e _ -> - match e.eexpr with - | TArray ({ eexpr = TLocal { v_extra = Some({v_params = _ :: _}) } }, _) -> (* captured transformation *) - false - | TArray(e1, e2) -> - ( match run_follow gen (follow e1.etype) with - | TInst({ cl_path = (["java"], "NativeArray") }, _) -> false - | _ -> true ) - | _ -> die "" __LOC__ - ) "__get" "__set"; - - let field_is_dynamic is_dynamic t field = - match field_access_esp gen (gen.greal_type t) field with - | FClassField (cl,p,_,_,_,t,_) -> - let p = change_param_type (TClassDecl cl) p in - is_dynamic (apply_params cl.cl_params p t) - | FEnumField _ -> false - | _ -> true - in - - let is_type_param e = match follow e with - | TInst( { cl_kind = KTypeParameter _ },[]) -> true - | _ -> false - in - - let is_dynamic_expr is_dynamic e = - is_dynamic e.etype || match e.eexpr with - | TField(tf, f) -> - field_is_dynamic is_dynamic tf.etype f - | _ -> - false - in - - let is_dynamic_op t = - is_dynamic t || is_boxed_type (gen.greal_type t) - in - - let may_nullable t = match gen.gfollow#run_f t with - | TAbstract({ a_path = ([], "Null") }, [t]) -> - (match follow t with - | TInst({ cl_path = ([], "String") }, []) - | TAbstract ({ a_path = ([], "Float") },[]) - | TInst({ cl_path = (["haxe"], "Int32")}, [] ) - | TInst({ cl_path = (["haxe"], "Int64")}, [] ) - | TAbstract ({ a_path = ([], "Int") },[]) - | TAbstract ({ a_path = ([], "Bool") },[]) -> Some t - | t when is_java_basic_type t -> Some t - | _ -> None ) - | _ -> None - in - - let is_double t = like_float t && not (like_int t) in - let is_int t = like_int t in - - let nullable_basic t = match gen.gfollow#run_f t with - | TAbstract({ a_path = ([],"Null") }, [t]) - | TType({ t_path = ([],"Null") }, [t]) when is_java_basic_type t -> - Some(t) - | _ -> - None - in - - DynamicOperators.configure gen - ~handle_strings:true - (fun e -> match e.eexpr with - | TBinop (Ast.OpEq, e1, e2) -> - is_dynamic_op e1.etype || is_dynamic_op e2.etype || is_type_param e1.etype || is_type_param e2.etype - | TBinop (Ast.OpAdd, e1, e2) - | TBinop (Ast.OpNotEq, e1, e2) -> is_dynamic_op e1.etype || is_dynamic_op e2.etype || is_type_param e1.etype || is_type_param e2.etype - | TBinop (Ast.OpLt, e1, e2) - | TBinop (Ast.OpLte, e1, e2) - | TBinop (Ast.OpGte, e1, e2) - | TBinop (Ast.OpGt, e1, e2) -> - is_dynamic_op e.etype || is_dynamic_op e1.etype || is_dynamic_op e2.etype || is_string e1.etype || is_string e2.etype - | TBinop (_, e1, e2) -> is_dynamic_op e.etype || is_dynamic_expr is_dynamic_op e1 || is_dynamic_expr is_dynamic_op e2 - | TUnop (_, _, e1) -> - is_dynamic_expr is_dynamic_op e1 - | _ -> false) - (fun e1 e2 -> - let is_null e = match e.eexpr with | TConst(TNull) | TIdent "__undefined__" -> true | _ -> false in - - match e1.eexpr, e2.eexpr with - | TConst c1, TConst c2 when is_null e1 || is_null e2 -> - { e1 with eexpr = TConst(TBool (c1 = c2)); etype = basic.tbool } - | _ when (is_null e1 || is_null e2) && not (is_java_basic_type e1.etype || is_java_basic_type e2.etype) -> - { e1 with eexpr = TBinop(Ast.OpEq, e1, e2); etype = basic.tbool } - | _ -> - let is_ref = match follow e1.etype, follow e2.etype with - | TDynamic _, _ - | _, TDynamic _ - | TAbstract ({ a_path = ([], "Float") },[]) , _ - | TInst( { cl_path = (["haxe"], "Int32") }, [] ), _ - | TInst( { cl_path = (["haxe"], "Int64") }, [] ), _ - | TAbstract ({ a_path = ([], "Int") },[]) , _ - | TAbstract ({ a_path = ([], "Bool") },[]) , _ - | _, TAbstract ({ a_path = ([], "Float") },[]) - | _, TAbstract ({ a_path = ([], "Int") },[]) - | _, TInst( { cl_path = (["haxe"], "Int32") }, [] ) - | _, TInst( { cl_path = (["haxe"], "Int64") }, [] ) - | _, TAbstract ({ a_path = ([], "Bool") },[]) - | TInst( { cl_kind = KTypeParameter _ }, [] ), _ - | _, TInst( { cl_kind = KTypeParameter _ }, [] ) -> false - | _, _ -> true - in - - let static = mk_static_field_access_infer (runtime_cl) (if is_ref then "refEq" else "eq") e1.epos [] in - { eexpr = TCall(static, [e1; e2]); etype = gen.gcon.basic.tbool; epos=e1.epos } - ) - (fun e e1 e2 -> - match may_nullable e1.etype, may_nullable e2.etype with - | Some t1, Some t2 -> - let t1, t2 = if is_string t1 || is_string t2 then - basic.tstring, basic.tstring - else if is_double t1 || is_double t2 then - basic.tfloat, basic.tfloat - else if is_int t1 || is_int t2 then - basic.tint, basic.tint - else t1, t2 in - { eexpr = TBinop(Ast.OpAdd, mk_cast t1 e1, mk_cast t2 e2); etype = e.etype; epos = e1.epos } - | _ -> - let static = mk_static_field_access_infer (runtime_cl) "plus" e1.epos [] in - mk_cast e.etype { eexpr = TCall(static, [e1; e2]); etype = t_dynamic; epos=e1.epos }) - (fun op e e1 e2 -> - match nullable_basic e1.etype, nullable_basic e2.etype with - | Some(t1), None when is_java_basic_type e2.etype -> - { e with eexpr = TBinop(op, mk_cast t1 e1, e2) } - | None, Some(t2) when is_java_basic_type e1.etype -> - { e with eexpr = TBinop(op, e1, mk_cast t2 e2) } - | _ -> - let handler = if is_string e1.etype then begin - { e1 with eexpr = TCall(mk_field_access gen e1 "compareTo" e1.epos, [ e2 ]); etype = gen.gcon.basic.tint } - end else begin - let static = mk_static_field_access_infer (runtime_cl) "compare" e1.epos [] in - { eexpr = TCall(static, [e1; e2]); etype = gen.gcon.basic.tint; epos=e1.epos } - end - in - let zero = Texpr.Builder.make_int gen.gcon.basic 0 e.epos in - { e with eexpr = TBinop(op, handler, zero) } - ); - - let closure_cl = get_cl (get_type gen (["haxe";"lang"],"Closure")) in - FilterClosures.configure gen (fun e1 s -> true) (ReflectionCFs.get_closure_func rcf_ctx closure_cl); - - ClassInstance.configure gen; - - CastDetect.configure gen (Some empty_ctor_type) false; - - SwitchToIf.configure gen (fun e -> - match e.eexpr with - | TSwitch switch -> - (match gen.gfollow#run_f switch.switch_subject.etype with - | TInst( { cl_path = (["haxe"], "Int32") }, [] ) - | TAbstract ({ a_path = ([], "Int") },[]) - | TInst({ cl_path = ([], "String") },[]) -> - (List.exists (fun case -> - List.exists (fun expr -> match expr.eexpr with | TConst _ -> false | _ -> true ) case.case_patterns - ) switch.switch_cases) - | _ -> true - ) - | _ -> die "" __LOC__ - ); - - ExpressionUnwrap.configure gen; - - (* UnnecessaryCastsRemoval.configure gen; *) - - IntDivisionSynf.configure gen; - - UnreachableCodeEliminationSynf.configure gen true; - - ArraySpliceOptimization.configure gen; - - ArrayDeclSynf.configure gen native_arr_cl change_param_type; - - JavaSpecificSynf.configure gen runtime_cl; - JavaSpecificESynf.configure gen runtime_cl; - - (* add native String as a String superclass *) - let str_cl = match gen.gcon.basic.tstring with | TInst(cl,_) -> cl | _ -> die "" __LOC__ in - str_cl.cl_super <- Some (get_cl (get_type gen (["haxe";"lang"], "NativeString")), []); - - Path.mkdir_from_path (gen.gcon.file ^ "/src"); - - let out_files = ref [] in - - (* add resources array *) - let res = ref [] in - Hashtbl.iter (fun name v -> - res := { eexpr = TConst(TString name); etype = gen.gcon.basic.tstring; epos = null_pos } :: !res; - let name = StringHelper.escape_res_name name ['/'] in - let full_path = gen.gcon.file ^ "/src/" ^ name in - Path.mkdir_from_path full_path; - - let f = open_out_bin full_path in - output_string f v; - close_out f; - - out_files := (gen.gcon.file_keys#get full_path) :: !out_files - ) gen.gcon.resources; - (try - let c = get_cl (Hashtbl.find gen.gtypes (["haxe"], "Resource")) in - let cf = PMap.find "content" c.cl_statics in - cf.cf_expr <- Some ({ eexpr = TArrayDecl(!res); etype = gen.gcon.basic.tarray gen.gcon.basic.tstring; epos = null_pos }) - with | Not_found -> ()); - - run_filters gen; - - RenameTypeParameters.run gen.gtypes_list; - - let parts = Str.split_delim (Str.regexp "[\\/]+") gen.gcon.file in - Path.mkdir_recursive "" parts; - - let source_dir = gen.gcon.file ^ "/src" in - List.iter (fun md -> - let w = SourceWriter.new_source_writer () in - let should_write = module_type_gen w md in - if should_write then begin - let path = change_path (t_path md) in - write_file gen w (source_dir ^ "/" ^ (String.concat "/" (fst path))) path "java" out_files; - end - ) gen.gtypes_list; - - if not (Common.defined gen.gcon Define.KeepOldOutput) then - clean_files gen (gen.gcon.file ^ "/src") !out_files gen.gcon.verbose; - - let path_s_desc path = path_s path [] in - dump_descriptor gen ("hxjava_build.txt") path_s_desc (fun md -> path_s_desc (t_infos md).mt_path); - if ( not (Common.defined gen.gcon Define.NoCompilation) ) then begin - let old_dir = Sys.getcwd() in - Sys.chdir gen.gcon.file; - let cmd = "haxelib" in - let args = ["run";"hxjava";"hxjava_build.txt";"--haxe-version";(string_of_int gen.gcon.version);"--feature-level";"1"] in - let args = - match gen.gentry_point with - | Some (name,_,_) -> - let name = if gen.gcon.debug then name ^ "-Debug" else name in - args @ ["--out";gen.gcon.file ^ "/" ^ name] - | _ -> - args - in - print_endline (cmd ^ " " ^ (String.concat " " args)); - if gen.gcon.run_command_args cmd args <> 0 then failwith "Build failed"; - Sys.chdir old_dir; - end - - with TypeNotFound path -> con.error ("Error. Module '" ^ (s_type_path path) ^ "' is required and was not included in build.") null_pos); - debug_mode := false diff --git a/src/macro/macroApi.ml b/src/macro/macroApi.ml index 155ed8c08ce..74bd97c4be6 100644 --- a/src/macro/macroApi.ml +++ b/src/macro/macroApi.ml @@ -439,12 +439,11 @@ and encode_platform p = | Flash -> 4, [] | Php -> 5, [] | Cpp -> 6, [] - | Cs -> 7, [] - | Java -> 8, [] - | Python -> 9, [] - | Hl -> 10, [] - | Eval -> 11, [] - | CustomTarget s -> 12, [(encode_string s)] + | Jvm -> 7, [] + | Python -> 8, [] + | Hl -> 9, [] + | Eval -> 10, [] + | CustomTarget s -> 11, [(encode_string s)] in encode_enum ~pos:None IPlatform tag pl @@ -2175,8 +2174,7 @@ let macro_api ccom get_api = let com = ccom() in let open CompilationContext in let kind = match com.platform with - | Java -> JavaLib - | Cs -> NetLib + | Jvm -> JavaLib | Flash -> SwfLib | _ -> failwith "Unsupported platform" in @@ -2184,15 +2182,6 @@ let macro_api ccom get_api = NativeLibraryHandler.add_native_lib com lib (); vnull ); - "add_native_arg", vfun1 (fun arg -> - let arg = decode_string arg in - let com = ccom() in - (match com.platform with - | Globals.Java | Globals.Cs | Globals.Cpp -> - com.c_args <- arg :: com.c_args - | _ -> failwith "Unsupported platform"); - vnull - ); "register_module_dependency", vfun2 (fun m file -> (get_api()).module_dependency (decode_string m) (decode_string file); vnull diff --git a/src/optimization/analyzerConfig.ml b/src/optimization/analyzerConfig.ml index 1d59a6c9d55..2889bbfcd3c 100644 --- a/src/optimization/analyzerConfig.ml +++ b/src/optimization/analyzerConfig.ml @@ -72,7 +72,7 @@ let get_base_config com = purity_inference = not (Common.raw_defined com "analyzer_no_purity_inference"); debug_kind = DebugNone; detail_times = (try int_of_string (Common.defined_value_safe com ~default:"0" Define.AnalyzerTimes) with _ -> 0); - user_var_fusion = (match com.platform with Flash | Java -> false | _ -> true) && (Common.raw_defined com "analyzer_user_var_fusion" || (not com.debug && not (Common.raw_defined com "analyzer_no_user_var_fusion"))); + user_var_fusion = (match com.platform with Flash | Jvm -> false | _ -> true) && (Common.raw_defined com "analyzer_user_var_fusion" || (not com.debug && not (Common.raw_defined com "analyzer_no_user_var_fusion"))); fusion_debug = false; } diff --git a/src/optimization/analyzerTexpr.ml b/src/optimization/analyzerTexpr.ml index b5ac00f6c3a..7b09d058d5e 100644 --- a/src/optimization/analyzerTexpr.ml +++ b/src/optimization/analyzerTexpr.ml @@ -129,7 +129,7 @@ let can_be_used_as_value com e = in try begin match com.platform,e.eexpr with - | (Cs | Cpp | Java | Flash | Lua),TConst TNull -> raise Exit + | (Cpp | Jvm | Flash | Lua),TConst TNull -> raise Exit | _ -> () end; loop e; @@ -515,9 +515,7 @@ module Fusion = struct in let e1 = skip e1 in let e2 = skip e2 in - is_assign_op op && target_handles_assign_ops com e3 && Texpr.equal e1 e2 && not (has_side_effect e1) && match com.platform with - | Cs when is_null e1.etype || is_null e2.etype -> false (* C# hates OpAssignOp on Null *) - | _ -> true + is_assign_op op && target_handles_assign_ops com e3 && Texpr.equal e1 e2 && not (has_side_effect e1) let handle_assigned_local actx v1 e1 el = let config = actx.AnalyzerTypes.config in @@ -674,8 +672,9 @@ module Fusion = struct if not !found && (((has_state_read ir || has_any_field_read ir)) || has_state_write ir || has_any_field_write ir) then raise Exit; {e with eexpr = TCall(e1,el)} | TObjectDecl fl -> + (* TODO can something be cleaned up here? *) (* The C# generator has trouble with evaluation order in structures (#7531). *) - let el = (match com.platform with Cs -> handle_el' | _ -> handle_el) (List.map snd fl) in + let el = handle_el (List.map snd fl) in if not !found && (has_state_write ir || has_any_field_write ir) then raise Exit; {e with eexpr = TObjectDecl (List.map2 (fun (s,_) e -> s,e) fl el)} | TArrayDecl el -> @@ -1015,7 +1014,7 @@ module Cleanup = struct | _,TConst (TBool false) -> optimize_binop {e with eexpr = TBinop(OpBoolAnd,e1,e2)} OpBoolAnd e1 e2 | _,TBlock [] -> {e with eexpr = TIf(e1,e2,None)} | _ -> match (Texpr.skip e2).eexpr with - | TBlock [] when com.platform <> Cs -> + | TBlock [] -> let e1' = mk (TUnop(Not,Prefix,e1)) e1.etype e1.epos in let e1' = optimize_unop e1' Not Prefix e1 in {e with eexpr = TIf(e1',e3,None)} diff --git a/src/optimization/inline.ml b/src/optimization/inline.ml index 6b77604dd7d..9cba36f0799 100644 --- a/src/optimization/inline.ml +++ b/src/optimization/inline.ml @@ -17,21 +17,10 @@ let mk_untyped_call name p params = let api_inline2 com c field params p = match c.cl_path, field, params with - | ([],"Type"),"enumIndex",[{ eexpr = TField (_,FEnum (en,f)) }] -> (match com.platform with - | Cs when en.e_extern && not (Meta.has Meta.HxGen en.e_meta) -> - (* We don't want to optimize enums from external sources; as they might change unexpectedly *) - (* and since native C# enums don't have the concept of index - they have rather a value, *) - (* which can't be mapped to a native API - this kind of substitution is dangerous *) - None - | _ -> - Some (mk (TConst (TInt (Int32.of_int f.ef_index))) com.basic.tint p)) + | ([],"Type"),"enumIndex",[{ eexpr = TField (_,FEnum (en,f)) }] -> + Some (mk (TConst (TInt (Int32.of_int f.ef_index))) com.basic.tint p) | ([],"Type"),"enumIndex",[{ eexpr = TCall({ eexpr = TField (_,FEnum (en,f)) },pl) }] when List.for_all (fun e -> not (has_side_effect e)) pl -> - (match com.platform with - | Cs when en.e_extern && not (Meta.has Meta.HxGen en.e_meta) -> - (* see comment above *) - None - | _ -> - Some (mk (TConst (TInt (Int32.of_int f.ef_index))) com.basic.tint p)) + Some (mk (TConst (TInt (Int32.of_int f.ef_index))) com.basic.tint p) | ([],"Std"),"int",[{ eexpr = TConst (TInt _) } as e] -> Some { e with epos = p } | ([],"String"),"fromCharCode",[{ eexpr = TConst (TInt i) }] when i > 0l && i < 128l -> @@ -99,10 +88,6 @@ let api_inline2 com c field params p = None (* out range, keep platform-specific behavior *) | _ -> Some { eexpr = TConst (TInt (Int32.of_float (floor f))); etype = com.basic.tint; epos = p }) - | (["cs"],"Lib"),("fixed" | "checked" | "unsafe"),[e] -> - Some (mk_untyped_call ("__" ^ field ^ "__") p [e]) - | (["cs"],"Lib"),("lock"),[obj;block] -> - Some (mk_untyped_call ("__lock__") p [obj;mk_block block]) | (["java"],"Lib"),("lock"),[obj;block] -> Some (mk_untyped_call ("__lock__") p [obj;mk_block block]) | _ -> @@ -176,11 +161,9 @@ let api_inline ctx c field params p = Some (Texpr.Builder.fcall (Texpr.Builder.make_static_this c p) "__implements" [o;t] tbool p) else Some (Texpr.Builder.fcall (eJsSyntax()) "instanceof" [o;t] tbool p) - | (["cs" | "java"],"Lib"),("nativeArray"),[{ eexpr = TArrayDecl args } as edecl; _] | (["haxe";"ds";"_Vector"],"Vector_Impl_"),("fromArrayCopy"),[{ eexpr = TArrayDecl args } as edecl] -> (try let platf = match ctx.com.platform with - | Cs -> "cs" - | Java -> "java" + | Jvm -> "java" | _ -> raise Exit in let mpath = if field = "fromArrayCopy" then diff --git a/src/optimization/optimizer.ml b/src/optimization/optimizer.ml index d51c8e246ca..47ed16d8f18 100644 --- a/src/optimization/optimizer.ml +++ b/src/optimization/optimizer.ml @@ -331,8 +331,7 @@ let reduce_control_flow com e = match e.eexpr with (* TODO: figure out what's wrong with these targets *) let require_cast = match com.platform with | Cpp | Flash -> true - | Java -> defined com Define.Jvm - | Cs -> defined com Define.EraseGenerics || defined com Define.FastCast + | Jvm -> true | _ -> false in Texpr.reduce_unsafe_casts ~require_cast e e.etype diff --git a/src/typing/fields.ml b/src/typing/fields.ml index ed16c63b862..a29be9a11f0 100644 --- a/src/typing/fields.ml +++ b/src/typing/fields.ml @@ -270,12 +270,7 @@ 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 = - let e = match ctx.com.platform with - | Cs -> - {e with etype = t} - | _ -> - mk (TCast(e,None)) t e.epos - in + let e = mk (TCast(e,None)) t e.epos in f e (follow_without_type t) in let type_field_by_e f e = diff --git a/src/typing/generic.ml b/src/typing/generic.ml index a0eebd9e8c3..cadbef00cfc 100644 --- a/src/typing/generic.ml +++ b/src/typing/generic.ml @@ -307,7 +307,6 @@ let build_generic_class ctx c p tl = | Meta.Access | Allow | Final | Hack - | Internal | Keep | KeepSub | NoClosure | NullSafety | Pure diff --git a/src/typing/strictMeta.ml b/src/typing/strictMeta.ml index 7ed54be3742..700573708ca 100644 --- a/src/typing/strictMeta.ml +++ b/src/typing/strictMeta.ml @@ -12,8 +12,6 @@ let get_native_repr md pos = | TAbstractDecl a -> a.a_path, a.a_meta in let rec loop acc = function - | (Meta.JavaCanonical,[EConst(String(pack,_)),_; EConst(String(name,_)),_],_) :: _ -> - ExtString.String.nsplit pack ".", name | (Meta.Native,[EConst(String(name,_)),_],_) :: meta -> loop (Ast.parse_path name) meta | _ :: meta -> @@ -51,10 +49,7 @@ let rec process_meta_argument ?(toplevel=true) ctx expr = match expr.eexpr with process_meta_argument ~toplevel ctx e | TTypeExpr md when toplevel -> let p = expr.epos in - if ctx.com.platform = Cs then - (ECall( (EConst(Ident "typeof"), p), [get_native_repr md expr.epos] ), p) - else - (efield(get_native_repr md expr.epos, "class"), p) + (efield(get_native_repr md expr.epos, "class"), p) | TTypeExpr md -> get_native_repr md expr.epos | TArrayDecl el -> @@ -104,12 +99,7 @@ let handle_fields ctx fields_to_check with_type_expr = let pos = snd expr in let field = (efield(with_type_expr,name), pos) in let fieldexpr = (EConst(Ident name),pos) in - let left_side = match ctx.com.platform with - | Cs -> field - | Java -> (ECall(field,[]),pos) - | _ -> die "" __LOC__ - in - + let left_side = (ECall(field,[]),pos) in let left = type_expr ctx left_side NoValue in let right = kind_of_type_against ctx left.etype expr in (EBinop(Ast.OpAssign,fieldexpr,process_meta_argument ctx right), pos) @@ -159,48 +149,27 @@ let field_to_type_path com e = loop e [] [] let get_strict_meta ctx meta params pos = - let pf = ctx.com.platform in let changed_expr, fields_to_check, ctype = match params with | [ECall(ef, el),p] -> let tpath = field_to_type_path ctx.com ef in - begin match pf with - | Cs -> - let el, fields = match List.rev el with - | (EObjectDecl(decl),_) :: el -> - List.rev el, decl - | _ -> - el, [] - in - let ptp = make_ptp tpath (snd ef) in - (ENew(ptp, el), p), fields, CTPath ptp - | Java -> - let fields = match el with - | [EObjectDecl(fields),_] -> - fields - | [] -> - [] - | (_,p) :: _ -> - display_error ctx.com "Object declaration expected" p; - [] - in - ef, fields, CTPath (make_ptp tpath (snd ef)) - | _ -> - Error.raise_typing_error "@:strict is not supported on this target" p - end + let fields = match el with + | [EObjectDecl(fields),_] -> + fields + | [] -> + [] + | (_,p) :: _ -> + display_error ctx.com "Object declaration expected" p; + [] + in + ef, fields, CTPath (make_ptp tpath (snd ef)) | [EConst(Ident i),p as expr] -> let tpath = { tpackage=[]; tname=i; tparams=[]; tsub=None } in let ptp = make_ptp tpath p in - if pf = Cs then - (ENew(ptp, []), p), [], CTPath ptp - else - expr, [], CTPath ptp + expr, [], CTPath ptp | [ (EField(_),p as field) ] -> let tpath = field_to_type_path ctx.com field in let ptp = make_ptp tpath p in - if pf = Cs then - (ENew(ptp, []), p), [], CTPath ptp - else - field, [], CTPath ptp + field, [], CTPath ptp | _ -> display_error ctx.com "A @:strict metadata must contain exactly one parameter. Please check the documentation for more information" pos; raise Exit @@ -211,7 +180,7 @@ let get_strict_meta ctx meta params pos = let with_type_expr = (ECheckType( (EConst (Ident "null"), pos), (ctype,null_pos) ), pos) in let extra = handle_fields ctx fields_to_check with_type_expr in let args = [make_meta ctx texpr extra] in - let args = if Common.defined ctx.com Define.Jvm then match t with + let args = match t with | TInst(c,_) -> let v = get_meta_string c.cl_meta Meta.Annotation in begin match v with @@ -224,20 +193,15 @@ let get_strict_meta ctx meta params pos = end; | _ -> args - else - args in meta, args, pos let check_strict_meta ctx metas = let pf = ctx.com.platform in match pf with - | Cs | Java -> + | Jvm -> let ret = ref [] in List.iter (function - | Meta.AssemblyStrict,params,pos -> (try - ret := get_strict_meta ctx Meta.AssemblyMeta params pos :: !ret - with | Exit -> ()) | Meta.Strict,params,pos -> (try ret := get_strict_meta ctx Meta.Meta params pos :: !ret with | Exit -> ()) diff --git a/src/typing/typeload.ml b/src/typing/typeload.ml index 5a2c33f0a52..3b11996a08b 100644 --- a/src/typing/typeload.ml +++ b/src/typing/typeload.ml @@ -315,7 +315,7 @@ let rec maybe_build_instance ctx t0 get_params p = let rec load_params ctx info params p = let is_rest = info.build_kind = BuildGenericBuild && (match info.build_params with [{ttp_name="Rest"}] -> true | _ -> false) in - let is_java_rest = ctx.com.platform = Java && info.build_extern in + let is_java_rest = ctx.com.platform = Jvm && info.build_extern in let is_rest = is_rest || is_java_rest in let load_param t = match t with diff --git a/src/typing/typeloadCheck.ml b/src/typing/typeloadCheck.ml index 5369903fb96..c1cac9b1430 100644 --- a/src/typing/typeloadCheck.ml +++ b/src/typing/typeloadCheck.ml @@ -237,8 +237,6 @@ let check_overriding ctx c f = if has_class_field_flag f CfOverride then display_error ctx.com ("Field " ^ f.cf_name ^ " is declared 'override' but doesn't override any field") f.cf_pos; NothingToDo - | _ when (has_class_flag c CExtern) && Meta.has Meta.CsNative c.cl_meta -> - NothingToDo (* -net-lib specific: do not check overrides on extern CsNative classes *) | Some (csup,params) -> let p = f.cf_name_pos in let i = f.cf_name in @@ -401,7 +399,7 @@ module Inheritance = struct valid_redefinition map1 map2 f2 t2 f (apply_params intf.cl_params params f.cf_type) with Unify_error l -> - if not (Meta.has Meta.CsNative c.cl_meta && (has_class_flag c CExtern)) then begin + if not ((has_class_flag c CExtern)) then begin (* TODO construct error with sub *) display_error com ("Field " ^ f.cf_name ^ " has different type than in " ^ s_type_path intf.cl_path) p; display_error ~depth:1 com (compl_msg "Interface field is defined here") f.cf_pos; @@ -441,7 +439,6 @@ module Inheritance = struct let check_interfaces ctx c = match c.cl_path with - | _ when (has_class_flag c CExtern) && Meta.has Meta.CsNative c.cl_meta -> () | _ -> List.iter (fun (intf,params) -> let missing = DynArray.create () in diff --git a/src/typing/typeloadFields.ml b/src/typing/typeloadFields.ml index 0a2465b99e2..14edc515192 100644 --- a/src/typing/typeloadFields.ml +++ b/src/typing/typeloadFields.ml @@ -33,7 +33,6 @@ open Error type class_init_ctx = { tclass : tclass; (* I don't trust ctx.c.curclass because it's mutable. *) is_lib : bool; - is_native : bool; is_core_api : bool; is_class_debug : bool; extends_public : bool; @@ -104,7 +103,6 @@ let dump_class_context cctx = Printer.s_record_fields "" [ "tclass",Printer.s_tclass "\t" cctx.tclass; "is_lib",string_of_bool cctx.is_lib; - "is_native",string_of_bool cctx.is_native; "is_core_api",string_of_bool cctx.is_core_api; "is_class_debug",string_of_bool cctx.is_class_debug; "extends_public",string_of_bool cctx.extends_public; @@ -457,8 +455,6 @@ let create_class_context c p = | _ -> None in let is_lib = Meta.has Meta.LibType c.cl_meta in - (* a native type will skip one check: the static vs non-static field *) - let is_native = Meta.has Meta.JavaNative c.cl_meta || Meta.has Meta.CsNative c.cl_meta in let rec extends_public c = Meta.has Meta.PublicFields c.cl_meta || match c.cl_super with @@ -468,7 +464,6 @@ let create_class_context c p = let cctx = { tclass = c; is_lib = is_lib; - is_native = is_native; is_core_api = Meta.has Meta.CoreApi c.cl_meta; is_class_debug = Meta.has (Meta.Custom ":debug.typeload") c.cl_meta; extends_public = extends_public c; @@ -734,9 +729,7 @@ module TypeBinding = struct if not fctx.is_static && not cctx.is_lib then begin match get_declared cf.cf_name c.cl_super with | None -> () | Some (csup,_) -> - (* this can happen on -net-lib generated classes if a combination of explicit interfaces and variables with the same name happens *) - if not ((has_class_flag csup CInterface) && Meta.has Meta.CsNative c.cl_meta) then - display_error ctx.com ("Redefinition of variable " ^ cf.cf_name ^ " in subclass is not allowed. Previously declared at " ^ (s_type_path csup.cl_path) ) cf.cf_name_pos + display_error ctx.com ("Redefinition of variable " ^ cf.cf_name ^ " in subclass is not allowed. Previously declared at " ^ (s_type_path csup.cl_path) ) cf.cf_name_pos end let bind_var_expression ctx_f cctx fctx cf e = @@ -841,7 +834,7 @@ module TypeBinding = struct incr stats.s_methods_typed; if (Meta.has (Meta.Custom ":debug.typing") (c.cl_meta @ cf.cf_meta)) then ctx.com.print (Printf.sprintf "Typing method %s.%s\n" (s_type_path c.cl_path) cf.cf_name); begin match ctx.com.platform with - | Java when is_java_native_function ctx cf.cf_meta cf.cf_pos -> + | Jvm when is_java_native_function ctx cf.cf_meta cf.cf_pos -> if e <> None then warning ctx WDeprecated "@:java.native function definitions shouldn't include an expression. This behaviour is deprecated." cf.cf_pos; cf.cf_expr <- None; @@ -1291,7 +1284,7 @@ let create_method (ctx,cctx,fctx) c f fd p = begin match fctx.default with | Some p -> begin match ctx.com.platform with - | Java -> + | Jvm -> 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; | _ -> @@ -1524,7 +1517,7 @@ let init_field (ctx,cctx,fctx) f = if not (has_class_flag c CExtern) && not (Meta.has Meta.Native f.cff_meta) then Naming.check_field_name ctx.com name p; List.iter (fun acc -> match (fst acc, f.cff_kind) with - | AFinal, FProp _ when not (has_class_flag c CExtern) && ctx.com.platform <> Java -> invalid_modifier_on_property ctx.com fctx (Ast.s_placed_access acc) (snd acc) + | AFinal, FProp _ when not (has_class_flag c CExtern) && ctx.com.platform <> Jvm -> invalid_modifier_on_property ctx.com fctx (Ast.s_placed_access acc) (snd acc) | APublic, _ | APrivate, _ | AStatic, _ | AFinal, _ | AExtern, _ -> () | ADynamic, FFun _ | AOverride, FFun _ | AMacro, FFun _ | AInline, FFun _ | AInline, FVar _ | AAbstract, FFun _ | AOverload, FFun _ -> () | AEnum, (FVar _ | FProp _) -> () @@ -1572,7 +1565,7 @@ let check_overload ctx f fs is_extern_class = display_error ~depth:1 ctx.com (compl_msg "The second field is declared here") f2.cf_pos; false with Not_found -> try - if ctx.com.platform <> Java || is_extern_class then raise Not_found; + if ctx.com.platform <> Jvm || is_extern_class then raise Not_found; let get_vmtype = ambiguate_funs in let f2 = List.find (fun f2 -> @@ -1723,7 +1716,7 @@ let init_class ctx_c cctx c p herits fields = () | 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 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 add_class_field_flag cf CfOverride; let is_var cf = match cf.cf_kind with @@ -1758,7 +1751,7 @@ let init_class ctx_c cctx 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 CInterface) && com.platform = Java then check_functional_interface ctx_c c; + if (has_class_flag c CInterface) && com.platform = Jvm 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; diff --git a/src/typing/typeloadModule.ml b/src/typing/typeloadModule.ml index 27058d58e8c..3e4e8df6587 100644 --- a/src/typing/typeloadModule.ml +++ b/src/typing/typeloadModule.ml @@ -432,7 +432,7 @@ module TypeLevel = struct delay ctx_m.g PBuildClass (fun() -> ignore(c.cl_build())); if Meta.has Meta.InheritDoc c.cl_meta then delay ctx_m.g 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 + if (ctx_m.com.platform = Jvm) && not (has_class_flag c CExtern) then delay ctx_m.g PTypeField (fun () -> let metas = StrictMeta.check_strict_meta ctx_m c.cl_meta in if metas <> [] then c.cl_meta <- metas @ c.cl_meta; @@ -511,7 +511,7 @@ module TypeLevel = struct 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_en.g 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 + if (ctx_en.com.platform = Jvm) && not e.e_extern then delay ctx_en.g PTypeField (fun () -> let metas = StrictMeta.check_strict_meta ctx_en e.e_meta in e.e_meta <- metas @ e.e_meta; @@ -565,12 +565,7 @@ 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_td (TTypeDecl t) t.t_meta (fun _ -> []) (fun _ -> ()); - if ctx_td.com.platform = Cs && t.t_meta <> [] then - delay ctx_td.g PTypeField (fun () -> - let metas = StrictMeta.check_strict_meta ctx_td t.t_meta in - if metas <> [] then t.t_meta <- metas @ t.t_meta; - ) + TypeloadFields.build_module_def ctx_td (TTypeDecl t) t.t_meta (fun _ -> []) (fun _ -> ()) 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 diff --git a/src/typing/typer.ml b/src/typing/typer.ml index 9f74c11e891..2bbfed0995c 100644 --- a/src/typing/typer.ml +++ b/src/typing/typer.ml @@ -394,29 +394,24 @@ let rec type_ident_raise ctx i p mode with_type = AKExpr (mk (TConst TSuper) t p) | "null" -> let acc = - (* Hack for #10787 *) - if ctx.com.platform = Cs then - AKExpr (null (spawn_monomorph ctx.e p) p) - else begin - 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 - | TMono r when not (is_nullable t) -> - (* If our expected type is a monomorph, bind it to Null. The is_nullable check is here because - the expected type could already be Null, in which case we don't want to double-wrap (issue #11286). *) - Monomorph.do_bind r (tnull()) - | _ -> - (* Otherwise there's no need to create a monomorph, we can just type the null literal - the way we expect it. *) - () - end; - t + 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 + | TMono r when not (is_nullable t) -> + (* If our expected type is a monomorph, bind it to Null. The is_nullable check is here because + the expected type could already be Null, in which case we don't want to double-wrap (issue #11286). *) + Monomorph.do_bind r (tnull()) | _ -> - tnull() - in - AKExpr (null t p) - end + (* Otherwise there's no need to create a monomorph, we can just type the null literal + the way we expect it. *) + () + end; + t + | _ -> + tnull() + in + AKExpr (null t p) in if mode = MGet then acc else AKNo(acc,p) | _ -> diff --git a/std/StdTypes.hx b/std/StdTypes.hx index 2da4ff0a721..b67e3c45556 100644 --- a/std/StdTypes.hx +++ b/std/StdTypes.hx @@ -60,7 +60,7 @@ **/ @:coreType @:notNull @:runtimeValue abstract Int to Float {} -#if (java || cs || hl || cpp) +#if (java || hl || cpp) /** Single-precision IEEE 32bit float (4-byte). **/ diff --git a/std/StringTools.hx b/std/StringTools.hx index 1369b56bd1a..208b2804d6b 100644 --- a/std/StringTools.hx +++ b/std/StringTools.hx @@ -50,8 +50,6 @@ class StringTools { return untyped s.__URLEncode(); #elseif java return postProcessUrlEncode(java.net.URLEncoder.encode(s, "UTF-8")); - #elseif cs - return untyped cs.system.Uri.EscapeDataString(s); #elseif python return python.lib.urllib.Parse.quote(s, ""); #elseif hl @@ -121,8 +119,6 @@ class StringTools { return java.net.URLDecoder.decode(s, "UTF-8") catch (e:Dynamic) throw e; - #elseif cs - return untyped cs.system.Uri.UnescapeDataString(s); #elseif python return python.lib.urllib.Parse.unquote(s); #elseif hl @@ -223,11 +219,9 @@ class StringTools { If `start` is the empty String `""`, the result is true. **/ - public static #if (cs || java || python || (js && js_es >= 6)) inline #end function startsWith(s:String, start:String):Bool { + public static #if (java || python || (js && js_es >= 6)) inline #end function startsWith(s:String, start:String):Bool { #if java return (cast s : java.NativeString).startsWith(start); - #elseif cs - return untyped s.StartsWith(start); #elseif hl return @:privateAccess (s.length >= start.length && s.bytes.compare(0, start.bytes, 0, start.length << 1) == 0); #elseif python @@ -248,11 +242,9 @@ class StringTools { If `end` is the empty String `""`, the result is true. **/ - public static #if (cs || java || python || (js && js_es >= 6)) inline #end function endsWith(s:String, end:String):Bool { + public static #if (java || python || (js && js_es >= 6)) inline #end function endsWith(s:String, end:String):Bool { #if java return (cast s : java.NativeString).endsWith(end); - #elseif cs - return untyped s.EndsWith(end); #elseif hl var elen = end.length; var slen = s.length; @@ -297,10 +289,7 @@ class StringTools { If `s` is the empty String `""` or consists only of space characters, the result is the empty String `""`. **/ - public #if cs inline #end static function ltrim(s:String):String { - #if cs - return untyped s.TrimStart(); - #else + public inline static function ltrim(s:String):String { var l = s.length; var r = 0; while (r < l && isSpace(s, r)) { @@ -310,7 +299,6 @@ class StringTools { return s.substr(r, l - r); else return s; - #end } /** @@ -322,10 +310,7 @@ class StringTools { If `s` is the empty String `""` or consists only of space characters, the result is the empty String `""`. **/ - public #if cs inline #end static function rtrim(s:String):String { - #if cs - return untyped s.TrimEnd(); - #else + public inline static function rtrim(s:String):String { var l = s.length; var r = 0; while (r < l && isSpace(s, l - r - 1)) { @@ -336,7 +321,6 @@ class StringTools { } else { return s; } - #end } /** @@ -344,10 +328,8 @@ class StringTools { This is a convenience function for `ltrim(rtrim(s))`. **/ - public #if (cs || java) inline #end static function trim(s:String):String { - #if cs - return untyped s.Trim(); - #elseif java + public #if java inline #end static function trim(s:String):String { + #if java return (cast s : java.NativeString).trim(); #else return ltrim(rtrim(s)); @@ -419,11 +401,6 @@ class StringTools { return s.split(sub).join(by); else return (cast s : java.NativeString).replace(sub, by); - #elseif cs - if (sub.length == 0) - return s.split(sub).join(by); - else - return untyped s.Replace(sub, by); #else return s.split(sub).join(by); #end @@ -486,8 +463,6 @@ class StringTools { return untyped s.cca(index); #elseif java return (index < s.length) ? cast(_charAt(s, index), Int) : -1; - #elseif cs - return (cast(index, UInt) < s.length) ? cast(s[index], Int) : -1; #elseif js return (cast s).charCodeAt(index); #elseif python @@ -525,8 +500,6 @@ class StringTools { return untyped s.cca(index); #elseif java return cast(_charAt(s, index), Int); - #elseif cs - return cast(s[index], Int); #elseif js return (cast s).charCodeAt(index); #elseif python @@ -576,7 +549,7 @@ class StringTools { return c != c; // fast NaN #elseif (neko || lua || eval) return c == null; - #elseif (cs || java || python) + #elseif (java || python) return c == -1; #else return false; diff --git a/std/Sys.hx b/std/Sys.hx index 3683b272767..def62d6bf32 100644 --- a/std/Sys.hx +++ b/std/Sys.hx @@ -43,8 +43,6 @@ extern class Sys { This does not include the interpreter or the name of the program file. (java)(eval) On Windows, non-ASCII Unicode arguments will not work correctly. - - (cs) Non-ASCII Unicode arguments will not work correctly. **/ static function args():Array; diff --git a/std/UInt.hx b/std/UInt.hx index 44634515ff3..862fd74d8b5 100644 --- a/std/UInt.hx +++ b/std/UInt.hx @@ -19,9 +19,9 @@ * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER * DEALINGS IN THE SOFTWARE. */ -#if ((flash || flash9doc || cs || hl) && !doc_gen) +#if ((flash || flash9doc || hl) && !doc_gen) /** - The unsigned `Int` type is only defined for Flash and C#. It's currently + The unsigned `Int` type is only defined for Flash. It's currently handled the same as a normal Int. @see https://haxe.org/manual/types-basic-types.html @@ -125,7 +125,7 @@ abstract UInt to Int from Int { #else /** - The unsigned `Int` type is only defined for Flash and C#. + The unsigned `Int` type is only defined for Flash. Simulate it for other platforms. @see https://haxe.org/manual/types-basic-types.html diff --git a/std/cs/Boot.hx b/std/cs/Boot.hx deleted file mode 100644 index 2b3639e623f..00000000000 --- a/std/cs/Boot.hx +++ /dev/null @@ -1,49 +0,0 @@ -/* - * 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 cs; - -import cs.internal.FieldLookup; -import cs.internal.Function; -import cs.internal.HxObject; -import cs.internal.Runtime; -#if !erase_generics -import cs.internal.Null; -#end -import cs.internal.StringExt; -#if unsafe -import cs.internal.BoxedPointer; -#end -import cs.StdTypes; -import haxe.ds.StringMap; -import Reflect; - -@:dox(hide) -class Boot { - @:keep public static function init():Void { - #if std_encoding_utf8 - cs.system.Console.InputEncoding = new cs.system.text.UTF8Encoding(); - cs.system.Console.OutputEncoding = new cs.system.text.UTF8Encoding(); - #end - cs.Lib.applyCultureChanges(); - } -} diff --git a/std/cs/Constraints.hx b/std/cs/Constraints.hx deleted file mode 100644 index c1caed8059d..00000000000 --- a/std/cs/Constraints.hx +++ /dev/null @@ -1,55 +0,0 @@ -/* - * 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 cs; - -/** - The type argument must be a value type. Any value type except Nullable_1 - can be specified. - - It is intended to be used as a native cs type parameter constraint, when - using `@:nativeGen`. This constraint won't have any effect on Haxe code. - If used as a real type, the underlying type will be `Dynamic`. -**/ -@:coreType abstract CsStruct from Dynamic {} - -/** - The type argument must be a reference type. This constraint applies also to - any class, interface, delegate, or array type. - - It is intended to be used as a native cs type parameter constraint, when - using `@:nativeGen`. This constraint won't have any effect on Haxe code. - If used as a real type, the underlying type will be `Dynamic`. -**/ -@:coreType abstract CsClass from Dynamic {} - -#if (cs_ver >= "7.3") -/** - The type argument must not be a reference type and must not contain any - reference type members at any level of nesting. - - It is intended to be used as a native cs type parameter constraint, when - using `@:nativeGen`. This constraint won't have any effect on Haxe code. - If used as a real type, the underlying type will be `Dynamic`. -**/ -@:coreType abstract CsUnmanaged from Dynamic {} -#end diff --git a/std/cs/Flags.hx b/std/cs/Flags.hx deleted file mode 100644 index 9e6281314dd..00000000000 --- a/std/cs/Flags.hx +++ /dev/null @@ -1,114 +0,0 @@ -/* - * 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 cs; - -/** - Use this type to have access to the bitwise operators of C# enums that have a `cs.system.FlagsAttribute` attribute. - - Usage example: - - ```haxe - import cs.system.reflection.BindingFlags; - var binding = new Flags(BindingFlags.Public) | BindingFlags.Static | BindingFlags.NonPublic; - ``` -**/ -abstract Flags(T) from T to T { - /** - Creates a new `Flags` type with an optional initial value. If no initial value was specified, - the default enum value for an empty flags attribute is specified - **/ - extern inline public function new(?initial:T) - this = initial == null ? cast null : initial; - - /** - Accessible through the bitwise OR operator (`|`). Returns a new `Flags` type with the flags - passed at `flags` added to it. - **/ - @:op(A | B) extern inline public function add(flags:Flags):Flags { - return new Flags(underlying() | flags.underlying()); - } - - /** - Accessible through the bitwise AND operator (`&`). Returns a new `Flags` type with - the flags that are set on both `this` and `flags` - **/ - @:op(A & B) extern inline public function bitAnd(flags:Flags):Flags { - return new Flags(underlying() & flags.underlying()); - } - - /** - Accessible through the bitwise XOR operator (`^`). - **/ - @:op(A ^ B) extern inline public function bitXor(flags:Flags):Flags { - return new Flags(underlying() & flags.underlying()); - } - - /** - Accesible through the bitwise negation operator (`~`). Returns a new `Flags` type - with all unset flags as set - but the ones that are set already. - **/ - @:op(~A) extern inline public function bitNeg():Flags { - return new Flags(~underlying()); - } - - /** - Returns a new `Flags` type with all flags set by `flags` unset - **/ - extern inline public function remove(flags:Flags):Flags { - return new Flags(underlying() & ~flags.underlying()); - } - - /** - Returns whether `flag` is present on `this` type - **/ - extern inline public function has(flag:T):Bool { - return underlying() & new Flags(flag).underlying() != null; - } - - /** - Returns whether `this` type has any flag set by `flags` also set - **/ - extern inline public function hasAny(flags:Flags):Bool { - return underlying() & flags.underlying() != null; - } - - /** - Returns whether `this` type has all flags set by `flags` also set - **/ - extern inline public function hasAll(flags:Flags):Bool { - return underlying() & flags.underlying() == flags.underlying(); - } - - extern inline private function underlying():EnumUnderlying - return this; -} - -@:coreType private abstract EnumUnderlying from T to T { - @:op(A | B) public static function or(lhs:EnumUnderlying, rhs:EnumUnderlying):T; - - @:op(A ^ B) public static function xor(lhs:EnumUnderlying, rhs:EnumUnderlying):T; - - @:op(A & B) public static function and(lhs:EnumUnderlying, rhs:EnumUnderlying):T; - - @:op(~A) public static function bneg(t:EnumUnderlying):T; -} diff --git a/std/cs/Lib.hx b/std/cs/Lib.hx deleted file mode 100644 index a1bfe415754..00000000000 --- a/std/cs/Lib.hx +++ /dev/null @@ -1,296 +0,0 @@ -/* - * 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 cs; - -import cs.system.Type; - -/** - Platform-specific C# Library. Provides some platform-specific functions for the C# target, - such as conversion from haxe types to native types and vice-versa. -**/ -class Lib { - private static var decimalSeparator:String; - - /** - Changes the current culture settings to allow a consistent cross-target behavior. - Currently the only change made is in regard to the decimal separator, which is always set to "." - **/ - public static function applyCultureChanges():Void { - var ci = new cs.system.globalization.CultureInfo(cs.system.threading.Thread.CurrentThread.CurrentCulture.Name, true); - decimalSeparator = ci.NumberFormat.NumberDecimalSeparator; - ci.NumberFormat.NumberDecimalSeparator = "."; - cs.system.threading.Thread.CurrentThread.CurrentCulture = ci; - } - - /** - Reverts the culture changes to the default settings. - **/ - public static function revertDefaultCulture():Void { - var ci = new cs.system.globalization.CultureInfo(cs.system.threading.Thread.CurrentThread.CurrentCulture.Name, true); - cs.system.threading.Thread.CurrentThread.CurrentCulture = ci; - } - - /** - Returns a native array from the supplied Array. This native array is unsafe to be written on, - as it may or may not be linked to the actual Array implementation. - - If equalLengthRequired is true, the result might be a copy of an array with the correct size. - **/ - extern inline public static function nativeArray(arr:Array, equalLengthRequired:Bool):NativeArray { - var ret = new cs.NativeArray(arr.length); - #if erase_generics - for (i in 0...arr.length) - ret[i] = arr[i]; - #else - p_nativeArray(arr, ret); - #end - return ret; - } - - #if !erase_generics - static function p_nativeArray(arr:Array, ret:cs.system.Array):Void { - var native:NativeArray = untyped arr.__a; - var len = arr.length; - cs.system.Array.Copy(native, 0, ret, 0, len); - } - #end - - /** - Provides support for the "as" keyword in C#. - If the object is not of the supplied type "T", it will return null instead of rasing an exception. - - This function will not work with Value Types (such as Int, Float, Bool...) - **/ - @:pure - extern public static inline function as(obj:Dynamic, cl:Class):T { - return untyped __as__(obj); - } - - /** - Returns a Class<> equivalent to the native System.Type type. - - Currently Haxe's Class<> is equivalent to System.Type, but this is an implementation detail. - This may change in the future, so use this function whenever you need to perform such conversion. - **/ - public static inline function fromNativeType(t:cs.system.Type):Class { - return untyped t; - } - - /** - Returns a System.Type equivalent to the Haxe Class<> type. - - Currently Haxe's Class<> is equivalent to System.Type, but this is an implementation detail. - This may change in the future, so use this function whenever you need to perform such conversion. - **/ - public static inline function toNativeType(cl:Class):Type { - return untyped cl; - } - - /** - Returns a System.Type equivalent to the Haxe Enum<> type. - **/ - public static inline function toNativeEnum(cl:Enum):Type { - return untyped cl; - } - - /** - Gets the native System.Type from the supplied object. Will throw an exception in case of null being passed. - [deprecated] - use `getNativeType` instead - **/ - @:deprecated('The function `nativeType` is deprecated and will be removed in later versions. Please use `getNativeType` instead') - public static inline function nativeType(obj:Dynamic):Type { - return untyped obj.GetType(); - } - - /** - Gets the native System.Type from the supplied object. Will throw an exception in case of null being passed. - **/ - public static inline function getNativeType(obj:Dynamic):Type { - return untyped obj.GetType(); - } - - #if erase_generics - inline private static function mkDynamic(native:NativeArray):NativeArray { - var ret = new cs.NativeArray(native.Length); - for (i in 0...native.Length) - ret[i] = native[i]; - return ret; - } - #end - - /** - Returns a Haxe Array of a native Array. - Unless `erase_generics` is defined, it won't copy the contents of the native array, - so unless any operation triggers an array resize, all changes made to the Haxe array - will affect the native array argument. - **/ - inline public static function array(native:cs.NativeArray):Array { - #if erase_generics - var dyn:NativeArray = mkDynamic(native); - return @:privateAccess Array.ofNative(dyn); - #else - return @:privateAccess Array.ofNative(native); - #end - } - - /** - Allocates a new Haxe Array with a predetermined size - **/ - inline public static function arrayAlloc(size:Int):Array { - return @:privateAccess Array.alloc(size); - } - - /** - Rethrow an exception. This is useful when manually filtering an exception in order - to keep the previous exception stack. - **/ - extern inline public static function rethrow(e:Dynamic):Void { - throw untyped __rethrow__; - } - - /** - Creates a "checked" block, which throws exceptions for overflows. - - Usage: - cs.Lib.checked({ - var x = 1000; - while(true) - { - x *= x; - } - }); - This method only exists at compile-time, so it can't be called via reflection. - **/ - extern public static inline function checked(block:V):Void { - untyped __checked__(block); - } - - /** - Ensures that one thread does not enter a critical section of code while another thread - is in the critical section. If another thread attempts to enter a locked code, it - will wait, block, until the object is released. - - This method only exists at compile-time, so it can't be called via reflection. - **/ - extern public static inline function lock(obj:O, block:V):Void { - untyped __lock__(obj, block); - } - - // Unsafe code manipulation - - #if unsafe - /** - Marks its parameters as fixed objects inside the defined block. - The first variable declarations that use cs.Lib.pointerOfArray() will be the fixed definitions. - Usage: - cs.Lib.fixed({ - var obj1 = cs.Lib.pointerOfArray(someArray); - var obj2 = cs.Lib.pointerOfArray(someArray2); - var obj3 = cs.Lib.pointerOfArray(someArray3); - //from now on, obj1, obj2 and obj3 are fixed - //we cannot change obj1, obj2 or obj3 variables like this: - //obj1++; - }); - - This method only exists at compile-time, so it can't be called via reflection. - **/ - extern public static inline function fixed(block:V):Void { - untyped __fixed__(block); - } - - /** - Marks the contained block as an unsafe block, meaning that it can contain unsafe code. - Usage: - cs.Lib.unsafe({ - //unsafe code is allowed inside here - }); - - This method only exists at compile-time, so it can't be called via reflection. - **/ - extern public static inline function unsafe(block:V):Void { - untyped __unsafe__(block); - } - - /** - Gets the pointer to the address of current local. Equivalent to the "&" operator in C# - Usage: - var x:Int = 0; - cs.Lib.unsafe({ - var addr = cs.Lib.addressOf(x); - x[0] = 42; - }); - trace(x); //42 - - This method only exists at compile-time, so it can't be called via reflection. - Warning: This method will only work if a local variable is passed as an argument. - **/ - extern public static inline function addressOf(variable:T):cs.Pointer { - return untyped __addressOf__(variable); - } - - /** - Gets the value of the pointer address. - Usage: - var x:Int = 0; - cs.Lib.unsafe({ - var addr = cs.Lib.addressOf(x); - trace(cs.Lib.valueOf(addr)); //0 - addr[0] = 42; - trace(cs.Lib.valueOf(addr)); //42 - }); - trace(x); //42 - - This method only exists at compile-time, so it can't be called via reflection. - **/ - extern public static inline function valueOf(pointer:cs.Pointer):T { - return untyped __valueOf__(pointer); - } - - /** - Transforms a managed native array into a Pointer. Must be inside a fixed statement - Usage: - var x:cs.NativeArray = new cs.NativeArray(1); - cs.Lib.unsafe({ - cs.Lib.fixed({ - var addr = cs.Lib.pointerOfArray(x); - trace(cs.Lib.valueOf(addr)); //0 - addr[0] = 42; - trace(cs.Lib.valueOf(addr)); //42 - }); - }); - trace(x[0]); //42 - - This method only exists at compile-time, so it can't be called via reflection. - **/ - extern public static inline function pointerOfArray(array:cs.NativeArray):cs.Pointer { - return untyped __ptr__(array); - } - - /** - Returns the byte size of the given struct. Only works with structs and basic types. - **/ - extern public static inline function sizeof(struct:Class):Int { - return untyped __sizeof__(struct); - } - #end -} diff --git a/std/cs/NativeArray.hx b/std/cs/NativeArray.hx deleted file mode 100644 index bfa756bc9e5..00000000000 --- a/std/cs/NativeArray.hx +++ /dev/null @@ -1,78 +0,0 @@ -/* - * 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 cs; - -import haxe.extern.Rest; - -/** - Represents a C# fixed-size Array (`T[]`) -**/ -extern class NativeArray extends cs.system.Array implements ArrayAccess { - /** - Creates a new array with the specified elements. - - Usage: - ```haxe - var elements = NativeArray.make(1,2,3,4,5,6); - ``` - **/ - static function make(elements:Rest):NativeArray; - - /** - Allocates a new array with size `len` - **/ - function new(len:Int):Void; - - /** - Alias to array's `Length` property. Returns the size of the array - **/ - var length(get, never):Int; - - extern inline private function get_length():Int - return this.Length; - - static function Reverse(arr:cs.system.Array):Void; - - /** - Returns an iterator so it's possible to use `for` with C#'s `NativeArray` - **/ - extern inline function iterator():NativeArrayIterator - return new NativeArrayIterator(this); -} - -@:dce private class NativeArrayIterator { - public var arr(default, null):NativeArray; - public var idx(default, null):UInt; - - inline public function new(arr) { - this.arr = arr; - this.idx = 0; - } - - inline public function hasNext():Bool - return this.idx < this.arr.Length; - - inline public function next():T { - return this.arr[this.idx++]; - } -} diff --git a/std/cs/Out.hx b/std/cs/Out.hx deleted file mode 100644 index c4e78ad8e7f..00000000000 --- a/std/cs/Out.hx +++ /dev/null @@ -1,33 +0,0 @@ -/* - * 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 cs; - -/** - This type represents "out" types for C# function parameters. - It only has effect on function parameters, and conversion to/from the referenced type is automatic. - - Note: Using this type should be considered a bad practice unless overriding a native function is needed. -**/ -@:analyzer(no_local_dce) -@:semantics(reference) -typedef Out = T; diff --git a/std/cs/Pointer.hx b/std/cs/Pointer.hx deleted file mode 100644 index 5d18c665369..00000000000 --- a/std/cs/Pointer.hx +++ /dev/null @@ -1,133 +0,0 @@ -/* - * 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 cs; - -import cs.StdTypes.Int64; - -/** - This type represents pointer types for C# function parameters. It should only - be used inside an unsafe context (not checked by the Haxe compiler) - - C# code: - int[] src; - fixed (int* pSrc = src) - { - ... - } - Haxe code: - var src:NativeArray; - cs.Lib.fixed({ - var pSrc:cs.Pointer = cs.Lib.pointerOfArray(src); - ... - }); - -**/ -#if !unsafe -#error "You need to define 'unsafe' to be able to use unsafe code in hxcs" -#else -@:runtimeValue @:coreType abstract Pointer from Int64 from PointerAccess to PointerAccess { - @:op(A + B) public static function addIp(lhs:Pointer, rhs:Int):Pointer; - - @:op(A + B) public static function addp(lhs:Pointer, rhs:Int64):Pointer; - - @:op(A * B) public static function mulIp(lhs:Pointer, rhs:Int):Pointer; - - @:op(A * B) public static function mulp(lhs:Pointer, rhs:Int64):Pointer; - - @:op(A % B) public static function modIp(lhs:Pointer, rhs:Int):Pointer; - - @:op(A % B) public static function modp(lhs:Pointer, rhs:Int64):Pointer; - - @:op(A - B) public static function subIp(lhs:Pointer, rhs:Int):Pointer; - - @:op(A - B) public static function subp(lhs:Pointer, rhs:Int64):Pointer; - - @:op(A / B) public static function divIp(lhs:Pointer, rhs:Int):Pointer; - - @:op(A / B) public static function divp(lhs:Pointer, rhs:Int64):Pointer; - - @:op(A | B) public static function orIp(lhs:Pointer, rhs:Int):Pointer; - - @:op(A | B) public static function orp(lhs:Pointer, rhs:Int64):Pointer; - - @:op(A ^ B) public static function xorIp(lhs:Pointer, rhs:Int):Pointer; - - @:op(A ^ B) public static function xorp(lhs:Pointer, rhs:Int64):Pointer; - - @:op(A & B) public static function andIp(lhs:Pointer, rhs:Int):Pointer; - - @:op(A & B) public static function andp(lhs:Pointer, rhs:Int64):Pointer; - - @:op(A << B) public static function shlIp(lhs:Pointer, rhs:Int):Pointer; - - @:op(A << B) public static function shlp(lhs:Pointer, rhs:Int64):Pointer; - - @:op(A >> B) public static function shrIp(lhs:Pointer, rhs:Int):Pointer; - - @:op(A >> B) public static function shrp(lhs:Pointer, rhs:Int64):Pointer; - - @:op(A > B) public static function gtp(lhs:Pointer, rhs:Pointer):Bool; - - @:op(A >= B) public static function gtep(lhs:Pointer, rhs:Pointer):Bool; - - @:op(A < B) public static function ltp(lhs:Pointer, rhs:Pointer):Bool; - - @:op(A <= B) public static function ltep(lhs:Pointer, rhs:Pointer):Bool; - - @:op(~A) public static function bnegp(t:Pointer):Pointer; - - @:op(A++) public static function prepp(t:Pointer):Pointer; - - @:op(A--) public static function prenn(t:Pointer):Pointer; - - @:op(++A) public static function postpp(t:Pointer):Pointer; - - @:op(--A) public static function postnn(t:Pointer):Pointer; - - /** - Returns a `cs.PointerAccess` type, which in turn allows the underlying Pointer's - fields to be accessed. - **/ - // @:analyzer(no_simplification) - public var acc(get, never):PointerAccess; - - // @:analyzer(no_simplification) - extern inline private function get_acc():PointerAccess - return (cast this : PointerAccess); - - // backwards compatibility - inline public function add(i:Int):Pointer { - return this + i; - } - - @:arrayAccess public static function getIp(p:Pointer, at:Int):T; - - @:arrayAccess public static function setIp(p:Pointer, at:Int, val:T):T; - - @:arrayAccess public static function getp(p:Pointer, at:Int64):T; - - @:arrayAccess public static function setp(p:Pointer, at:Int64, val:T):T; -} - -@:forward abstract PointerAccess(T) {} -#end diff --git a/std/cs/Ref.hx b/std/cs/Ref.hx deleted file mode 100644 index 609bd2aa5dd..00000000000 --- a/std/cs/Ref.hx +++ /dev/null @@ -1,32 +0,0 @@ -/* - * 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 cs; - -/** - This type represents "ref" types for C# function parameters. - It only has effect on function parameters, and conversion to/from the referenced type is automatic. - - Note: Using this type should be considered a bad practice unless overriding a native function is needed. -**/ -@:semantics(reference) -typedef Ref = T; diff --git a/std/cs/StdTypes.hx b/std/cs/StdTypes.hx deleted file mode 100644 index d2d72e90d89..00000000000 --- a/std/cs/StdTypes.hx +++ /dev/null @@ -1,153 +0,0 @@ -/* - * 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 cs; - -@:notNull @:runtimeValue @:coreType extern abstract Int8 to Int {} -@:notNull @:runtimeValue @:coreType extern abstract Int16 to Int {} -@:notNull @:runtimeValue @:coreType extern abstract Char16 from Int {} -@:notNull @:runtimeValue @:coreType extern abstract UInt8 to Int from Int {} -@:notNull @:runtimeValue @:coreType extern abstract UInt16 to Int {} - -@:notNull @:runtimeValue @:coreType extern abstract Int64 from Int from Float { - @:op(A + B) public static function addI(lhs:Int64, rhs:Int):Int64; - - @:op(A + B) public static function add(lhs:Int64, rhs:Int64):Int64; - - @:op(A * B) public static function mulI(lhs:Int64, rhs:Int):Int64; - - @:op(A * B) public static function mul(lhs:Int64, rhs:Int64):Int64; - - @:op(A % B) public static function modI(lhs:Int64, rhs:Int):Int64; - - @:op(A % B) public static function mod(lhs:Int64, rhs:Int64):Int64; - - @:op(A - B) public static function subI(lhs:Int64, rhs:Int):Int64; - - @:op(A - B) public static function sub(lhs:Int64, rhs:Int64):Int64; - - @:op(A / B) public static function divI(lhs:Int64, rhs:Int):Int64; - - @:op(A / B) public static function div(lhs:Int64, rhs:Int64):Int64; - - @:op(A | B) public static function orI(lhs:Int64, rhs:Int):Int64; - - @:op(A | B) public static function or(lhs:Int64, rhs:Int64):Int64; - - @:op(A ^ B) public static function xorI(lhs:Int64, rhs:Int):Int64; - - @:op(A ^ B) public static function xor(lhs:Int64, rhs:Int64):Int64; - - @:op(A & B) public static function andI(lhs:Int64, rhs:Int):Int64; - - @:op(A & B) public static function and(lhs:Int64, rhs:Int64):Int64; - - @:op(A << B) public static function shlI(lhs:Int64, rhs:Int):Int64; - - @:op(A << B) public static function shl(lhs:Int64, rhs:Int64):Int64; - - @:op(A >> B) public static function shrI(lhs:Int64, rhs:Int):Int64; - - @:op(A >> B) public static function shr(lhs:Int64, rhs:Int64):Int64; - - @:op(A > B) public static function gt(lhs:Int64, rhs:Int64):Bool; - - @:op(A >= B) public static function gte(lhs:Int64, rhs:Int64):Bool; - - @:op(A < B) public static function lt(lhs:Int64, rhs:Int64):Bool; - - @:op(A <= B) public static function lte(lhs:Int64, rhs:Int64):Bool; - - @:op(~A) public static function bneg(t:Int64):Int64; - - @:op(-A) public static function neg(t:Int64):Int64; - - @:op(++A) public static function preIncrement(t:Int64):Int64; - - @:op(A++) public static function postIncrement(t:Int64):Int64; - - @:op(--A) public static function preDecrement(t:Int64):Int64; - - @:op(A--) public static function postDecrement(t:Int64):Int64; -} - -@:notNull @:runtimeValue @:coreType extern abstract UInt64 from Int from Int64 from Float from haxe.Int64 { - @:op(A + B) public static function addI(lhs:UInt64, rhs:Int):UInt64; - - @:op(A + B) public static function add(lhs:UInt64, rhs:UInt64):UInt64; - - @:op(A * B) public static function mulI(lhs:UInt64, rhs:Int):UInt64; - - @:op(A * B) public static function mul(lhs:UInt64, rhs:UInt64):UInt64; - - @:op(A % B) public static function modI(lhs:UInt64, rhs:Int):UInt64; - - @:op(A % B) public static function mod(lhs:UInt64, rhs:UInt64):UInt64; - - @:op(A - B) public static function subI(lhs:UInt64, rhs:Int):UInt64; - - @:op(A - B) public static function sub(lhs:UInt64, rhs:UInt64):UInt64; - - @:op(A / B) public static function divI(lhs:UInt64, rhs:Int):UInt64; - - @:op(A / B) public static function div(lhs:UInt64, rhs:UInt64):UInt64; - - @:op(A | B) public static function orI(lhs:UInt64, rhs:Int):UInt64; - - @:op(A | B) public static function or(lhs:UInt64, rhs:UInt64):UInt64; - - @:op(A ^ B) public static function xorI(lhs:UInt64, rhs:Int):UInt64; - - @:op(A ^ B) public static function xor(lhs:UInt64, rhs:UInt64):UInt64; - - @:op(A & B) public static function andI(lhs:UInt64, rhs:Int):UInt64; - - @:op(A & B) public static function and(lhs:UInt64, rhs:UInt64):UInt64; - - @:op(A << B) public static function shlI(lhs:UInt64, rhs:Int):UInt64; - - @:op(A << B) public static function shl(lhs:UInt64, rhs:UInt64):UInt64; - - @:op(A >> B) public static function shrI(lhs:UInt64, rhs:Int):UInt64; - - @:op(A >> B) public static function shr(lhs:UInt64, rhs:UInt64):UInt64; - - @:op(A > B) public static function gt(lhs:UInt64, rhs:UInt64):Bool; - - @:op(A >= B) public static function gte(lhs:UInt64, rhs:UInt64):Bool; - - @:op(A < B) public static function lt(lhs:UInt64, rhs:UInt64):Bool; - - @:op(A <= B) public static function lte(lhs:UInt64, rhs:UInt64):Bool; - - @:op(~A) public static function bneg(t:UInt64):UInt64; - - @:op(-A) public static function neg(t:UInt64):UInt64; - - @:op(++A) public static function preIncrement(t:UInt64):UInt64; - - @:op(A++) public static function postIncrement(t:UInt64):UInt64; - - @:op(--A) public static function preDecrement(t:UInt64):UInt64; - - @:op(A--) public static function postDecrement(t:UInt64):UInt64; -} diff --git a/std/cs/Syntax.hx b/std/cs/Syntax.hx deleted file mode 100644 index 176cb250225..00000000000 --- a/std/cs/Syntax.hx +++ /dev/null @@ -1,56 +0,0 @@ -/* - * Copyright (C)2005-2021 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 cs; - -import haxe.Rest; - -/** - Generate C# syntax not directly supported by Haxe. - Use only at low-level when specific target-specific code-generation is required. -**/ -@:noClosure -extern class Syntax { - /** - Inject `code` directly into generated source. - - `code` must be a string constant. - - Additional `args` are supported to provide code interpolation, for example: - ```haxe - Syntax.code("System.Console.WriteLine({0} + {1})", "hi", 42); - ``` - will generate - ```haxe - System.Console.WriteLine("hi" + 42); - ``` - - Emits a compilation error if the count of `args` does not match the count of placeholders in `code`. - **/ - static function code(code:String, args:Rest):Dynamic; - - /** - Inject `code` directly into generated source. - The same as `cs.Syntax.code` except this one does not provide code interpolation. - **/ - static function plainCode(code:String):Dynamic; -} diff --git a/std/cs/_std/Array.hx b/std/cs/_std/Array.hx deleted file mode 100644 index e17ab87fe94..00000000000 --- a/std/cs/_std/Array.hx +++ /dev/null @@ -1,479 +0,0 @@ -/* - * 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. - */ - -import cs.NativeArray; -import haxe.iterators.ArrayKeyValueIterator; - -#if core_api_serialize -@:meta(System.Serializable) -#end -final class Array implements ArrayAccess { - public var length(default, null):Int; - - private var __a:NativeArray; - - @:skipReflection static var __hx_toString_depth = 0; - @:skipReflection static inline final __hx_defaultCapacity = 4; - - #if erase_generics - inline private static function ofNative(native:NativeArray):Array { - return new Array(native); - } - #else - inline private static function ofNative(native:NativeArray):Array { - return new Array(native); - } - #end - - inline private static function alloc(size:Int):Array { - return new Array(new NativeArray(size)); - } - - @:overload public function new():Void { - this.length = 0; - this.__a = new NativeArray(0); - } - - #if erase_generics - @:overload private function new(native:NativeArray) { - this.length = native.Length; - this.__a = untyped native; - } - #else - @:overload private function new(native:NativeArray) { - this.length = native.Length; - this.__a = native; - } - #end - - public function concat(a:Array):Array { - var len = length + a.length; - var retarr = new NativeArray(len); - cs.system.Array.Copy(__a, 0, retarr, 0, length); - cs.system.Array.Copy(a.__a, 0, retarr, length, a.length); - - return ofNative(retarr); - } - - private function concatNative(a:NativeArray):Void { - var __a = __a; - var len = length + a.Length; - if (__a.Length >= len) { - cs.system.Array.Copy(a, 0, __a, length, length); - } else { - var newarr = new NativeArray(len); - cs.system.Array.Copy(__a, 0, newarr, 0, length); - cs.system.Array.Copy(a, 0, newarr, length, a.Length); - - this.__a = newarr; - } - - this.length = len; - } - - public function indexOf(x:T, ?fromIndex:Int):Int { - var len = length, i:Int = (fromIndex == null) ? 0 : fromIndex; - if (i < 0) { - i += len; - if (i < 0) - i = 0; - } else if (i >= len) { - return -1; - } - return cs.system.Array.IndexOf(__a, x, i, len - i); - } - - public function lastIndexOf(x:T, ?fromIndex:Int):Int { - var len = length, i:Int = (fromIndex == null) ? len - 1 : fromIndex; - if (i >= len) { - i = len - 1; - } else if (i < 0) { - i += len; - if (i < 0) - return -1; - } - return cs.system.Array.LastIndexOf(__a, x, i, i + 1); - } - - public function join(sep:String):String { - var buf = new StringBuf(); - var i = -1; - - var first = true; - var length = length; - while (++i < length) { - if (first) - first = false; - else - buf.add(sep); - buf.add(__a[i]); - } - - return buf.toString(); - } - - public function pop():Null { - var __a = __a; - var length = length; - if (length > 0) { - var val = __a[--length]; - __a[length] = null; - this.length = length; - - return val; - } else { - return null; - } - } - - public function push(x:T):Int { - if (length >= __a.Length) { - var newLen = length == 0 ? __hx_defaultCapacity : (length << 1); - var newarr = new NativeArray(newLen); - __a.CopyTo(newarr, 0); - - this.__a = newarr; - } - - __a[length] = x; - return ++length; - } - - public function reverse():Void { - var i = 0; - var l = this.length; - var a = this.__a; - var half = l >> 1; - l -= 1; - while (i < half) { - var tmp = a[i]; - a[i] = a[l - i]; - a[l - i] = tmp; - i += 1; - } - } - - public function shift():Null { - var l = this.length; - if (l == 0) - return null; - - var a = this.__a; - var x = a[0]; - l -= 1; - cs.system.Array.Copy(a, 1, a, 0, length - 1); - a[l] = null; - this.length = l; - - return x; - } - - public function slice(pos:Int, ?end:Int):Array { - if (pos < 0) { - pos = this.length + pos; - if (pos < 0) - pos = 0; - } - if (end == null) - end = this.length; - else if (end < 0) - end = this.length + end; - if (end > this.length) - end = this.length; - var len = end - pos; - if (len < 0) - return new Array(); - - var newarr = new NativeArray(len); - cs.system.Array.Copy(__a, pos, newarr, 0, len); - - return ofNative(newarr); - } - - public function sort(f:T->T->Int):Void { - if (length == 0) - return; - quicksort(0, length - 1, f); - } - - private function quicksort(lo:Int, hi:Int, f:T->T->Int):Void { - var buf = __a; - var i = lo, j = hi; - var p = buf[(i + j) >> 1]; - while (i <= j) { - while (i < hi && f(buf[i], p) < 0) - i++; - while (j > lo && f(buf[j], p) > 0) - j--; - if (i <= j) { - var t = buf[i]; - buf[i++] = buf[j]; - buf[j--] = t; - } - } - - if (lo < j) - quicksort(lo, j, f); - if (i < hi) - quicksort(i, hi, f); - } - - public function splice(pos:Int, len:Int):Array { - if (len < 0) - return new Array(); - if (pos < 0) { - pos = this.length + pos; - if (pos < 0) - pos = 0; - } - if (pos > this.length) { - pos = 0; - len = 0; - } else if (pos + len > this.length) { - len = this.length - pos; - if (len < 0) - len = 0; - } - var a = this.__a; - - var ret = new NativeArray(len); - cs.system.Array.Copy(a, pos, ret, 0, len); - var ret = ofNative(ret); - - var end = pos + len; - cs.system.Array.Copy(a, end, a, pos, this.length - end); - this.length -= len; - while (--len >= 0) - a[this.length + len] = null; - return ret; - } - - private function spliceVoid(pos:Int, len:Int):Void { - if (len < 0) - return; - if (pos < 0) { - pos = this.length + pos; - if (pos < 0) - pos = 0; - } - if (pos > this.length) { - pos = 0; - len = 0; - } else if (pos + len > this.length) { - len = this.length - pos; - if (len < 0) - len = 0; - } - var a = this.__a; - - var end = pos + len; - cs.system.Array.Copy(a, end, a, pos, this.length - end); - this.length -= len; - while (--len >= 0) - a[this.length + len] = null; - } - - public function toString():String { - if (__hx_toString_depth >= 5) { - return "..."; - } - ++__hx_toString_depth; - try { - var s = __hx_toString(); - --__hx_toString_depth; - return s; - } catch (e:Dynamic) { - --__hx_toString_depth; - throw(e); - } - } - - @:skipReflection - function __hx_toString():String { - var ret = new StringBuf(); - var a = __a; - ret.add("["); - var first = true; - for (i in 0...length) { - if (first) - first = false; - else - ret.add(","); - ret.add(a[i]); - } - - ret.add("]"); - return ret.toString(); - } - - public function unshift(x:T):Void { - var __a = __a; - var length = length; - if (length >= __a.Length) { - var newLen = (length << 1) + 1; - var newarr = new NativeArray(newLen); - cs.system.Array.Copy(__a, 0, newarr, 1, length); - - this.__a = newarr; - } else { - cs.system.Array.Copy(__a, 0, __a, 1, length); - } - - this.__a[0] = x; - ++this.length; - } - - public function insert(pos:Int, x:T):Void { - var l = this.length; - if (pos < 0) { - pos = l + pos; - if (pos < 0) - pos = 0; - } - if (pos >= l) { - this.push(x); - return; - } else if (pos == 0) { - this.unshift(x); - return; - } - - if (l >= __a.Length) { - var newLen = (length << 1) + 1; - var newarr = new NativeArray(newLen); - cs.system.Array.Copy(__a, 0, newarr, 0, pos); - newarr[pos] = x; - cs.system.Array.Copy(__a, pos, newarr, pos + 1, l - pos); - - this.__a = newarr; - ++this.length; - } else { - var __a = __a; - cs.system.Array.Copy(__a, pos, __a, pos + 1, l - pos); - cs.system.Array.Copy(__a, 0, __a, 0, pos); - __a[pos] = x; - ++this.length; - } - } - - public function remove(x:T):Bool { - var __a = __a; - var i = -1; - var length = length; - while (++i < length) { - if (__a[i] == x) { - cs.system.Array.Copy(__a, i + 1, __a, i, length - i - 1); - __a[--this.length] = null; - - return true; - } - } - - return false; - } - - public inline function map(f:T->S):Array { - var ret = alloc(length); - for (i in 0...length) - ret.__unsafe_set(i, f(__unsafe_get(i))); - return ret; - } - - public function contains(x:T):Bool { - var __a = __a; - var i = -1; - var length = length; - while (++i < length) { - if (__a[i] == x) - return true; - } - return false; - } - - public inline function filter(f:T->Bool):Array { - var ret = []; - for (i in 0...length) { - var elt = __unsafe_get(i); - if (f(elt)) - ret.push(elt); - } - return ret; - } - - public function copy():Array { - var len = length; - var __a = __a; - var newarr = new NativeArray(len); - cs.system.Array.Copy(__a, 0, newarr, 0, len); - return ofNative(newarr); - } - - public inline function iterator():haxe.iterators.ArrayIterator { - return new haxe.iterators.ArrayIterator(this); - } - - public inline function keyValueIterator() : ArrayKeyValueIterator - { - return new ArrayKeyValueIterator(this); - } - - public function resize(len:Int):Void { - if (length < len) { - if (__a.length < len) { - cs.system.Array.Resize(__a, len); - } - this.length = len; - } else if (length > len) { - spliceVoid(len, length - len); - } - } - - private function __get(idx:Int):T { - return if ((cast idx : UInt) >= length) null else __a[idx]; - } - - private function __set(idx:Int, v:T):T { - var idx:UInt = idx; - var __a = __a; - if (idx >= __a.Length) { - var len = idx + 1; - if (idx == __a.Length) - len = (idx << 1) + 1; - var newArr = new NativeArray(len); - __a.CopyTo(newArr, 0); - this.__a = __a = newArr; - } - - if (idx >= length) - this.length = idx + 1; - - return __a[idx] = v; - } - - private inline function __unsafe_get(idx:Int):T { - return __a[idx]; - } - - private inline function __unsafe_set(idx:Int, val:T):T { - return __a[idx] = val; - } -} diff --git a/std/cs/_std/Date.hx b/std/cs/_std/Date.hx deleted file mode 100644 index 49b0f126db5..00000000000 --- a/std/cs/_std/Date.hx +++ /dev/null @@ -1,162 +0,0 @@ -/* - * 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. - */ - -import cs.system.DateTime; -import cs.system.DateTimeKind; -import cs.system.TimeSpan; -import haxe.Int64; - -#if core_api_serialize -@:meta(System.Serializable) -#end -@:coreApi class Date { - @:readOnly private static var epochTicks:Int64 = new DateTime(1970, 1, 1).Ticks; - - private var date:DateTime; - private var dateUTC:DateTime; - - @:overload public function new(year:Int, month:Int, day:Int, hour:Int, min:Int, sec:Int):Void { - if (day <= 0) - day = 1; - if (year <= 0) - year = 1; - date = new DateTime(year, month + 1, day, hour, min, sec, DateTimeKind.Local); - dateUTC = date.ToUniversalTime(); - } - - @:overload private function new(native:DateTime) { - if (native.Kind == DateTimeKind.Utc) { - dateUTC = native; - date = dateUTC.ToLocalTime(); - } else { - date = native; - dateUTC = date.ToUniversalTime(); - } - } - - public inline function getTime():Float { - #if (net_ver < 35) - return cast(cs.system.TimeZone.CurrentTimeZone.ToUniversalTime(date).Ticks - epochTicks, Float) / cast(TimeSpan.TicksPerMillisecond, Float); - #else - return cast(cs.system.TimeZoneInfo.ConvertTimeToUtc(date).Ticks - epochTicks, Float) / cast(TimeSpan.TicksPerMillisecond, Float); - #end - } - - public inline function getHours():Int { - return date.Hour; - } - - public inline function getMinutes():Int { - return date.Minute; - } - - public inline function getSeconds():Int { - return date.Second; - } - - public inline function getFullYear():Int { - return date.Year; - } - - public inline function getMonth():Int { - return date.Month - 1; - } - - public inline function getDate():Int { - return date.Day; - } - - public inline function getDay():Int { - return cast(date.DayOfWeek, Int); - } - - public inline function getUTCHours():Int { - return dateUTC.Hour; - } - - public inline function getUTCMinutes():Int { - return dateUTC.Minute; - } - - public inline function getUTCSeconds():Int { - return dateUTC.Second; - } - - public inline function getUTCFullYear():Int { - return dateUTC.Year; - } - - public inline function getUTCMonth():Int { - return dateUTC.Month - 1; - } - - public inline function getUTCDate():Int { - return dateUTC.Day; - } - - public inline function getUTCDay():Int { - return cast(dateUTC.DayOfWeek, Int); - } - - public inline function getTimezoneOffset():Int { - return Std.int((cast(dateUTC.Ticks - date.Ticks, Float) / cast(TimeSpan.TicksPerMillisecond, Float)) / 60000.); - } - - public function toString():String { - return date.ToString("yyyy-MM-dd HH\\:mm\\:ss"); - } - - static public inline function now():Date { - return new Date(DateTime.Now); - } - - static public inline function fromTime(t:Float):Date { - #if (net_ver < 35) - return new Date(cs.system.TimeZone.CurrentTimeZone.ToLocalTime(new DateTime(cast(t * cast(TimeSpan.TicksPerMillisecond, Float), Int64) + epochTicks))); - #else - return new Date(cs.system.TimeZoneInfo.ConvertTimeFromUtc(new DateTime(cast(t * cast(TimeSpan.TicksPerMillisecond, Float), Int64) + epochTicks), - cs.system.TimeZoneInfo.Local)); - #end - } - - static public function fromString(s:String):Date { - switch (s.length) { - case 8: // hh:mm:ss - var k = s.split(":"); - return new Date(new DateTime(1970, 1, 1, Std.parseInt(k[0]), Std.parseInt(k[1]), Std.parseInt(k[2]), DateTimeKind.Utc)); - case 10: // YYYY-MM-DD - var k = s.split("-"); - return new Date(new DateTime(Std.parseInt(k[0]), Std.parseInt(k[1]), Std.parseInt(k[2]), 0, 0, 0, DateTimeKind.Local)); - case 19: // YYYY-MM-DD hh:mm:ss - var k = s.split(" "); - var y = k[0].split("-"); - var t = k[1].split(":"); - return new Date(new DateTime(Std.parseInt(y[0]), Std.parseInt(y[1]), Std.parseInt(y[2]), Std.parseInt(t[0]), Std.parseInt(t[1]), Std.parseInt(t[2]), DateTimeKind.Local)); - default: - throw "Invalid date format : " + s; - } - } - - private static inline function fromNative(d:cs.system.DateTime):Date { - return new Date(d); - } -} diff --git a/std/cs/_std/EReg.hx b/std/cs/_std/EReg.hx deleted file mode 100644 index 4b6bcea0789..00000000000 --- a/std/cs/_std/EReg.hx +++ /dev/null @@ -1,135 +0,0 @@ -/* - * 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. - */ - -import cs.system.text.regularexpressions.Regex; -import cs.system.text.regularexpressions.Match; -import cs.system.text.regularexpressions.RegexOptions; -import cs.system.text.regularexpressions.*; - -@:coreApi final class EReg { - private var regex:Regex; - private var m:Match; - private var isGlobal:Bool; - private var cur:String; - - public function new(r:String, opt:String):Void { - var opts:Int = cast CultureInvariant; - for (i in 0...opt.length) - untyped { - switch (cast(opt[i], Int)) { - case 'i'.code: - opts |= cast(IgnoreCase, Int); - case 'g'.code: - isGlobal = true; - case 'm'.code: - opts |= cast(Multiline, Int); - #if (!unity && !unity_std_target) - case 'c'.code: - opts |= cast(Compiled, Int); - #end - } - } - - this.regex = new Regex(r, cast(opts, RegexOptions)); - } - - public function match(s:String):Bool { - m = regex.Match(s); - cur = s; - return m.Success; - } - - public function matched(n:Int):String { - if (m == null || cast(n, UInt) > m.Groups.Count) - throw "EReg::matched"; - if (!m.Groups[n].Success) - return null; - return m.Groups[n].Value; - } - - public function matchedLeft():String { - return untyped cur.Substring(0, m.Index); - } - - public function matchedRight():String { - return untyped cur.Substring(m.Index + m.Length); - } - - public function matchedPos():{pos:Int, len:Int} { - return {pos: m.Index, len: m.Length}; - } - - public function matchSub(s:String, pos:Int, len:Int = -1):Bool { - m = if (len < 0) regex.Match(s, pos) else regex.Match(s, pos, len); - cur = s; - return m.Success; - } - - public function split(s:String):Array { - if (isGlobal) - return cs.Lib.array(regex.Split(s)); - var m = regex.Match(s); - if (!m.Success) - return [s]; - return untyped [s.Substring(0, m.Index), s.Substring(m.Index + m.Length)]; - } - - inline function start(group:Int):Int { - return m.Groups[group].Index; - } - - inline function len(group:Int):Int { - return m.Groups[group].Length; - } - - public function replace(s:String, by:String):String { - return (isGlobal) ? regex.Replace(s, by) : regex.Replace(s, by, 1); - } - - public function map(s:String, f:EReg->String):String { - var offset = 0; - var buf = new StringBuf(); - do { - if (offset >= s.length) - break; - else if (!matchSub(s, offset)) { - buf.add(s.substr(offset)); - break; - } - var p = matchedPos(); - buf.add(s.substr(offset, p.pos - offset)); - buf.add(f(this)); - if (p.len == 0) { - buf.add(s.substr(p.pos, 1)); - offset = p.pos + 1; - } else - offset = p.pos + p.len; - } while (isGlobal); - if (!isGlobal && offset > 0 && offset < s.length) - buf.add(s.substr(offset)); - return buf.toString(); - } - - public static inline function escape(s:String):String { - return Regex.Escape(s); - } -} diff --git a/std/cs/_std/Math.hx b/std/cs/_std/Math.hx deleted file mode 100644 index 0bc15157ed7..00000000000 --- a/std/cs/_std/Math.hx +++ /dev/null @@ -1,134 +0,0 @@ -/* - * 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. - */ -@:coreApi @:nativeGen class Math { - @:readOnly - private static var rand = new cs.system.Random(); - - @:readOnly - public static var PI(default, null) = cs.system.Math.PI; - @:readOnly - public static var NaN(default, null) = cs.system.Double.NaN; - @:readOnly - public static var NEGATIVE_INFINITY(default, null) = cs.system.Double.NegativeInfinity; - @:readOnly - public static var POSITIVE_INFINITY(default, null) = cs.system.Double.PositiveInfinity; - - public static inline function abs(v:Float):Float { - return cs.system.Math.Abs(v); - } - - public static inline function min(a:Float, b:Float):Float { - return cs.system.Math.Min(a, b); - } - - public static inline function max(a:Float, b:Float):Float { - return cs.system.Math.Max(a, b); - } - - public static inline function sin(v:Float):Float { - return cs.system.Math.Sin(v); - } - - public static inline function cos(v:Float):Float { - return cs.system.Math.Cos(v); - } - - public static inline function atan2(y:Float, x:Float):Float { - return cs.system.Math.Atan2(y, x); - } - - public static inline function tan(v:Float):Float { - return cs.system.Math.Tan(v); - } - - public static inline function exp(v:Float):Float { - return cs.system.Math.Exp(v); - } - - public static inline function log(v:Float):Float { - return cs.system.Math.Log(v); - } - - public static inline function sqrt(v:Float):Float { - return cs.system.Math.Sqrt(v); - } - - public static inline function fround(v:Float):Float { - return cs.system.Math.Floor(v + 0.5); - } - - public static inline function ffloor(v:Float):Float { - return cs.system.Math.Floor(v); - } - - public static inline function fceil(v:Float):Float { - return cs.system.Math.Ceiling(v); - } - - public static function round(v:Float):Int { - var vint = Std.int(v); - var dec = v - vint; - if (dec >= 1 || dec <= -1) - return vint; // overflow - if (dec >= .5) - return vint + 1; - if (dec < -.5) - return vint - 1; - return vint; - } - - public static inline function floor(v:Float):Int { - return Std.int(cs.system.Math.Floor(v)); - } - - public static inline function ceil(v:Float):Int { - return Std.int(cs.system.Math.Ceiling(v)); - } - - public static inline function atan(v:Float):Float { - return cs.system.Math.Atan(v); - } - - public static inline function asin(v:Float):Float { - return cs.system.Math.Asin(v); - } - - public static inline function acos(v:Float):Float { - return cs.system.Math.Acos(v); - } - - public static inline function pow(v:Float, exp:Float):Float { - return cs.system.Math.Pow(v, exp); - } - - public static inline function random():Float { - return rand.NextDouble(); - } - - public static inline function isFinite(f:Float):Bool { - return !cs.system.Double.IsInfinity(f) && !cs.system.Double.IsNaN(f); - } - - public static inline function isNaN(f:Float):Bool { - return cs.system.Double.IsNaN(f); - } -} diff --git a/std/cs/_std/Reflect.hx b/std/cs/_std/Reflect.hx deleted file mode 100644 index 4f8f03f1de3..00000000000 --- a/std/cs/_std/Reflect.hx +++ /dev/null @@ -1,162 +0,0 @@ -/* - * 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. - */ - -import cs.internal.Function; -import cs.system.reflection.*; -import cs.internal.*; -import cs.internal.HxObject; -import cs.internal.Runtime; -import cs.Flags; -import cs.Lib; -import cs.system.Object; -import cs.system.reflection.*; - -@:coreApi class Reflect { - public static function hasField(o:Dynamic, field:String):Bool { - var ihx:IHxObject = Lib.as(o, IHxObject); - if (ihx != null) - return untyped ihx.__hx_getField(field, FieldLookup.hash(field), false, true, false) != Runtime.undefined; - - return Runtime.slowHasField(o, field); - } - - @:keep - public static function field(o:Dynamic, field:String):Dynamic { - var ihx:IHxObject = Lib.as(o, IHxObject); - if (ihx != null) - return untyped ihx.__hx_getField(field, FieldLookup.hash(field), false, false, false); - - return Runtime.slowGetField(o, field, false); - } - - @:keep - public static function setField(o:Dynamic, field:String, value:Dynamic):Void { - var ihx:IHxObject = Lib.as(o, IHxObject); - if (ihx != null) - untyped ihx.__hx_setField(field, FieldLookup.hash(field), value, false); - else - Runtime.slowSetField(o, field, value); - } - - public static function getProperty(o:Dynamic, field:String):Dynamic { - var ihx:IHxObject = Lib.as(o, IHxObject); - if (ihx != null) - return untyped ihx.__hx_getField(field, FieldLookup.hash(field), false, false, true); - - if (Runtime.slowHasField(o, "get_" + field)) - return Runtime.slowCallField(o, "get_" + field, null); - - return Runtime.slowGetField(o, field, false); - } - - public static function setProperty(o:Dynamic, field:String, value:Dynamic):Void { - var ihx:IHxObject = Lib.as(o, IHxObject); - if (ihx != null) - untyped ihx.__hx_setField(field, FieldLookup.hash(field), value, true); - else if (Runtime.slowHasField(o, 'set_$field')) - Runtime.slowCallField(o, 'set_$field', cs.NativeArray.make(value)); - else - Runtime.slowSetField(o, field, value); - } - - public static function callMethod(o:Dynamic, func:haxe.Constraints.Function, args:Array):Dynamic { - var args = cs.Lib.nativeArray(args, true); - return untyped cast(func, Function).__hx_invokeDynamic(args); - } - - @:keep - public static function fields(o:Dynamic):Array { - var ihx = Lib.as(o, IHxObject); - if (ihx != null) { - var ret = []; - untyped ihx.__hx_getFields(ret); - return ret; - } else if (Std.isOfType(o, cs.system.Type)) { - return Type.getClassFields(o); - } else { - return instanceFields(untyped o.GetType()); - } - } - - private static function instanceFields(c:Class):Array { - var c = cs.Lib.toNativeType(c); - var ret = []; - var mis = c.GetFields(new cs.Flags(BindingFlags.Public) | BindingFlags.Instance | BindingFlags.FlattenHierarchy); - for (i in 0...mis.Length) { - var i = mis[i]; - ret.push(i.Name); - } - return ret; - } - - inline public static function isFunction(f:Dynamic):Bool { - return Std.isOfType(f, Function); - } - - public static function compare(a:T, b:T):Int { - return cs.internal.Runtime.compare(a, b); - } - - @:access(cs.internal.Closure) - public static function compareMethods(f1:Dynamic, f2:Dynamic):Bool { - if (f1 == f2) - return true; - - if (Std.isOfType(f1, Closure) && Std.isOfType(f2, Closure)) { - var f1c:Closure = cast f1; - var f2c:Closure = cast f2; - - return Runtime.refEq(f1c.obj, f2c.obj) && f1c.field == f2c.field; - } - - return false; - } - - public static function isObject(v:Dynamic):Bool { - return v != null && !(Std.isOfType(v, HxEnum) || Std.isOfType(v, Function) || Std.isOfType(v, cs.system.ValueType)); - } - - public static function isEnumValue(v:Dynamic):Bool { - return v != null && (Std.isOfType(v, HxEnum) || Std.isOfType(v, cs.system.Enum)); - } - - public static function deleteField(o:Dynamic, field:String):Bool { - var ihx = Lib.as(o, DynamicObject); - if (ihx != null) - return untyped ihx.__hx_deleteField(field, FieldLookup.hash(field)); - return false; - } - - public static function copy(o:Null):Null { - if (o == null) - return null; - var o2:Dynamic = {}; - for (f in Reflect.fields(o)) - Reflect.setField(o2, f, Reflect.field(o, f)); - return cast o2; - } - - @:overload(function(f:Array->Void):Dynamic {}) - public static function makeVarArgs(f:Array->Dynamic):Dynamic { - return new VarArgsFunction(f); - } -} diff --git a/std/cs/_std/Std.hx b/std/cs/_std/Std.hx deleted file mode 100644 index d5fad62257b..00000000000 --- a/std/cs/_std/Std.hx +++ /dev/null @@ -1,214 +0,0 @@ -/* - * 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. - */ - -import cs.Boot; -import cs.Lib; - -using StringTools; - -@:coreApi @:nativeGen class Std { - @:deprecated('Std.is is deprecated. Use Std.isOfType instead.') - public static inline function is(v:Dynamic, t:Dynamic):Bool { - return isOfType(v, t); - } - - public static function isOfType(v:Dynamic, t:Dynamic):Bool { - if (v == null) - return false; - if (t == null) - return false; - var clt = cs.Lib.as(t, cs.system.Type); - if (clt == null) - return false; - - switch (clt.ToString()) { - case "System.Double": - return untyped __cs__('{0} is double || {0} is int', v); - case "System.Int32": - return cs.internal.Runtime.isInt(v); - case "System.Boolean": - return untyped __cs__('{0} is bool', v); - case "System.Object": - return true; - } - - var vt = cs.Lib.getNativeType(v); - - if (clt.IsAssignableFrom(vt)) - return true; - - #if !erase_generics - for (iface in clt.GetInterfaces()) { - var g = cs.internal.Runtime.getGenericAttr(iface); - if (g != null && g.generic == clt) { - return iface.IsAssignableFrom(vt); - } - } - #end - - return false; - } - - public static function string(s:Dynamic):String { - if (s == null) - return "null"; - if (Std.isOfType(s, Bool)) - return cast(s, Bool) ? "true" : "false"; - - return s.ToString(); - } - - public static function int(x:Float):Int { - return cast x; - } - - static inline function isSpaceChar(code:Int):Bool - return (code > 8 && code < 14) || code == 32; - - static inline function isHexPrefix(cur:Int, next:Int):Bool - return cur == '0'.code && (next == 'x'.code || next == 'X'.code); - - static inline function isDecimalDigit(code:Int):Bool - return '0'.code <= code && code <= '9'.code; - - static inline function isHexadecimalDigit(code:Int):Bool - return isDecimalDigit(code) || ('a'.code <= code && code <= 'f'.code) || ('A'.code <= code && code <= 'F'.code); - - public static function parseInt(x:String):Null { - if (x == null) - return null; - - final len = x.length; - var index = 0; - - inline function hasIndex(index:Int) - return index < len; - - // skip whitespace - while (hasIndex(index)) { - if (!isSpaceChar(x.unsafeCodeAt(index))) - break; - ++index; - } - - // handle sign - final isNegative = hasIndex(index) && { - final sign = x.unsafeCodeAt(index); - if (sign == '-'.code || sign == '+'.code) { - ++index; - } - sign == '-'.code; - } - - // handle base - final isHexadecimal = hasIndex(index + 1) && isHexPrefix(x.unsafeCodeAt(index), x.unsafeCodeAt(index + 1)); - if (isHexadecimal) - index += 2; // skip prefix - - // handle digits - final firstInvalidIndex = { - var cur = index; - if (isHexadecimal) { - while (hasIndex(cur)) { - if (!isHexadecimalDigit(x.unsafeCodeAt(cur))) - break; - ++cur; - } - } else { - while (hasIndex(cur)) { - if (!isDecimalDigit(x.unsafeCodeAt(cur))) - break; - ++cur; - } - } - cur; - } - - // no valid digits - if (index == firstInvalidIndex) - return null; - - final result = cs.system.Convert.ToInt32(x.substring(index, firstInvalidIndex), if (isHexadecimal) 16 else 10); - return if (isNegative) -result else result; - } - - public static function parseFloat(x:String):Float { - if (x == null) - return Math.NaN; - x = StringTools.ltrim(x); - var found = false, - hasDot = false, - hasSign = false, - hasE = false, - hasESign = false, - hasEData = false; - var i = -1; - inline function getch(i:Int):Int - return cast((untyped x : cs.system.String)[i]); - - while (++i < x.length) { - var chr = getch(i); - if (chr >= '0'.code && chr <= '9'.code) { - if (hasE) { - hasEData = true; - } - found = true; - } else - switch (chr) { - case 'e'.code | 'E'.code if (!hasE): - hasE = true; - case '.'.code if (!hasDot): - hasDot = true; - case '-'.code, '+'.code if (!found && !hasSign): - hasSign = true; - case '-'.code | '+'.code if (found && !hasESign && hasE && !hasEData): - hasESign = true; - case _: - break; - } - } - if (hasE && !hasEData) { - i--; - if (hasESign) - i--; - } - if (i != x.length) { - x = x.substr(0, i); - } - return try cs.system.Double.Parse(x, cs.system.globalization.CultureInfo.InvariantCulture) catch (e:Dynamic) Math.NaN; - } - - extern inline public static function downcast(value:T, c:Class):S { - return cs.Lib.as(value, c); - } - - @:deprecated('Std.instance() is deprecated. Use Std.downcast() instead.') - extern inline public static function instance(value:T, c:Class):S { - return downcast(value, c); - } - - public static function random(x:Int):Int { - if (x <= 0) - return 0; - return untyped Math.rand.Next(x); - } -} diff --git a/std/cs/_std/String.hx b/std/cs/_std/String.hx deleted file mode 100644 index af78337d21c..00000000000 --- a/std/cs/_std/String.hx +++ /dev/null @@ -1,67 +0,0 @@ -/* - * 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. - */ - -import cs.StdTypes; - -@:coreApi extern class String implements ArrayAccess { - @:overload private static function Compare(s1:String, s2:String):Int; - @:overload private static function Compare(s1:String, s2:String, kind:cs.system.StringComparison):Int; - - private static function CompareOrdinal(s1:String, s2:String):Int; - - var length(default, null):Int; - - function new(string:String):Void; - - function toUpperCase():String; - - function toLowerCase():String; - - function charAt(index:Int):String; - - function charCodeAt(index:Int):Null; - - function indexOf(str:String, ?startIndex:Int):Int; - - function lastIndexOf(str:String, ?startIndex:Int):Int; - - function split(delimiter:String):Array; - - function substr(pos:Int, ?len:Int):String; - - function substring(startIndex:Int, ?endIndex:Int):String; - - function toString():String; - - static function fromCharCode(code:Int):String; - - private function IndexOf(value:String, startIndex:Int, comparisonType:cs.system.StringComparison):Int; - private function Replace(oldValue:String, newValue:String):String; - private function StartsWith(value:String):Bool; - private function EndsWith(value:String):Bool; - private function TrimStart():String; - private function TrimEnd():String; - private function Trim():String; - private function CompareTo(obj:Dynamic):Int; - @:overload(function(startIndex:Int):String {}) - private function Substring(startIndex:Int, length:Int):String; -} diff --git a/std/cs/_std/StringBuf.hx b/std/cs/_std/StringBuf.hx deleted file mode 100644 index b46bb5cb9eb..00000000000 --- a/std/cs/_std/StringBuf.hx +++ /dev/null @@ -1,60 +0,0 @@ -/* - * 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. - */ - -import cs.system.text.StringBuilder; - -@:coreApi -class StringBuf { - private var b:StringBuilder; - - public var length(get, never):Int; - - public inline function new():Void { - b = new StringBuilder(); - } - - inline function get_length():Int { - return b.Length; - } - - public inline function add(x:T):Void { - b.Append(Std.string(x)); - } - - public inline function addSub(s:String, pos:Int, ?len:Int):Void { - b.Append(s, pos, (len == null) ? (s.length - pos) : len); - } - - public function addChar(c:Int):Void - untyped { - if (c >= 0x10000) { - b.Append(cast((c >> 10) + 0xD7C0, cs.StdTypes.Char16)); - b.Append(cast((c & 0x3FF) + 0xDC00, cs.StdTypes.Char16)); - } else { - b.Append(cast(c, cs.StdTypes.Char16)); - } - } - - public inline function toString():String { - return b.ToString(); - } -} diff --git a/std/cs/_std/Sys.hx b/std/cs/_std/Sys.hx deleted file mode 100644 index 9adef45f86f..00000000000 --- a/std/cs/_std/Sys.hx +++ /dev/null @@ -1,174 +0,0 @@ -/* - * 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. - */ - -import sys.io.Process; -import cs.system.Environment; -import cs.system.threading.Thread; - -@:coreApi -class Sys { - private static var _args:Array; - - public static inline function print(v:Dynamic):Void { - cs.system.Console.Write(v); - } - - public static inline function println(v:Dynamic):Void { - cs.system.Console.WriteLine(v); - } - - public static function args():Array { - if (_args == null) { - var ret = cs.Lib.array(Environment.GetCommandLineArgs()); - ret.shift(); - _args = ret; - } - return _args.copy(); - } - - public static inline function getEnv(s:String):String { - return Environment.GetEnvironmentVariable(s); - } - - public static function putEnv(s:String, v:Null):Void { - Environment.SetEnvironmentVariable(s, v); - } - - public static function environment():Map { - final env = new haxe.ds.StringMap(); - final nenv = Environment.GetEnvironmentVariables().GetEnumerator(); - while (nenv.MoveNext()) { - env.set(nenv.Key, nenv.Value); - } - return env; - } - - public static inline function sleep(seconds:Float):Void { - Thread.Sleep(Std.int(seconds * 1000)); - } - - public static function setTimeLocale(loc:String):Bool { - // TODO C# - return false; - } - - public static inline function getCwd():String { - return haxe.io.Path.addTrailingSlash(cs.system.io.Directory.GetCurrentDirectory()); - } - - public static inline function setCwd(s:String):Void { - cs.system.io.Directory.SetCurrentDirectory(s); - } - - public static function systemName():String { - // doing a switch with strings since MacOS might not be available - switch (Environment.OSVersion.Platform + "") { - case "Unix": - return "Linux"; - case "Xbox": - return "Xbox"; - case "MacOSX": - return "Mac"; - default: - var ver = cast(Environment.OSVersion.Platform, Int); - if (ver == 4 || ver == 6 || ver == 128) - return "Linux"; - return "Windows"; - } - } - - public static function command(cmd:String, ?args:Array):Int { - var proc = Process.createNativeProcess(cmd, args); - proc.add_OutputDataReceived(new cs.system.diagnostics.DataReceivedEventHandler(function(p, evtArgs) { - var data = evtArgs.Data; - if (data != null && data != "") - println(data); - })); - var stderr = stderr(); - proc.add_ErrorDataReceived(new cs.system.diagnostics.DataReceivedEventHandler(function(p, evtArgs) { - var data = evtArgs.Data; - if (data != null && data != "") - stderr.writeString(data + "\n"); - })); - proc.Start(); - proc.BeginOutputReadLine(); - proc.BeginErrorReadLine(); - proc.WaitForExit(); - var exitCode = proc.ExitCode; - proc.Dispose(); - return exitCode; - } - - public static inline function exit(code:Int):Void { - Environment.Exit(code); - } - - @:readOnly static var epochTicks = new cs.system.DateTime(1970, 1, 1).Ticks; - - public static function time():Float { - return cast((cs.system.DateTime.UtcNow.Ticks - epochTicks), Float) / cast(cs.system.TimeSpan.TicksPerSecond, Float); - } - - public static inline function cpuTime():Float { - return Environment.TickCount / 1000; - } - - @:deprecated("Use programPath instead") public static inline function executablePath():String { - return cs.system.reflection.Assembly.GetExecutingAssembly().GetName().CodeBase; - } - - public static function programPath():String { - return cs.system.reflection.Assembly.GetExecutingAssembly().Location; - } - - public static function getChar(echo:Bool):Int { - #if !(Xbox || CF || MF) // Xbox, Compact Framework, Micro Framework - return cast(cs.system.Console.ReadKey(!echo).KeyChar, Int); - #else - return -1; - #end - } - - public static inline function stdin():haxe.io.Input { - #if !(Xbox || CF || MF) - return new cs.io.NativeInput(cs.system.Console.OpenStandardInput()); - #else - return null; - #end - } - - public static inline function stdout():haxe.io.Output { - #if !(Xbox || CF || MF) - return new cs.io.NativeOutput(cs.system.Console.OpenStandardOutput()); - #else - return null; - #end - } - - public static inline function stderr():haxe.io.Output { - #if !(Xbox || CF || MF) - return new cs.io.NativeOutput(cs.system.Console.OpenStandardError()); - #else - return null; - #end - } -} diff --git a/std/cs/_std/Type.hx b/std/cs/_std/Type.hx deleted file mode 100644 index cfdd7410008..00000000000 --- a/std/cs/_std/Type.hx +++ /dev/null @@ -1,344 +0,0 @@ -/* - * 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. - */ - -import cs.Lib; -import cs.internal.HxObject; -import cs.internal.Runtime; -import cs.internal.Function; -import cs.Flags; -import cs.system.Object; -import cs.system.reflection.*; - -using StringTools; - -enum ValueType { - TNull; - TInt; - TFloat; - TBool; - TObject; - TFunction; - TClass(c:Class); - TEnum(e:Enum); - TUnknown; -} - -@:coreApi class Type { - public static function getClass(o:T):Null> { - if (Object.ReferenceEquals(o, null) || Std.isOfType(o, DynamicObject) || Std.isOfType(o, cs.system.Type)) - return null; - - return cast cs.Lib.getNativeType(o); - } - - public static function getEnum(o:EnumValue):Enum { - if (Std.isOfType(o, HxEnum)) - return cast cs.Lib.getNativeType(o).BaseType; // enum constructors are subclasses of an enum type - else if (Std.isOfType(o, cs.system.Enum)) - return cast cs.Lib.getNativeType(o); - return null; - } - - public static function getSuperClass(c:Class):Class { - var base = Lib.toNativeType(c).BaseType; - if (Object.ReferenceEquals(base, null) || base.ToString() == "haxe.lang.HxObject" || base.ToString() == "System.Object") - return null; - return Lib.fromNativeType(base); - } - - public static function getClassName(c:Class):String { - var ret = Lib.toNativeType(c).ToString(); - #if no_root - if (ret.length > 10 && StringTools.startsWith(ret, "haxe.root.")) - ret = ret.substr(10); - #end - - return switch (ret) { - // TODO: are those really needed? - case "System.Int32": "Int"; - case "System.Double": "Float"; - case "System.String": "String"; - case "System.Boolean": "Bool"; - case "System.Object": "Dynamic"; - case "System.Type": "Class"; - default: cast(ret, cs.system.String).Split(cs.NativeArray.make(("`".code : cs.StdTypes.Char16)))[0]; - } - } - - public static function getEnumName(e:Enum):String { - var ret = Lib.toNativeType(cast e).ToString(); - #if no_root - if (ret.length > 10 && StringTools.startsWith(ret, "haxe.root.")) - ret = ret.substr(10); - #end - return ret; - } - - public static function resolveClass(name:String):Class { - #if no_root - if (name.indexOf(".") == -1) - name = "haxe.root." + name; - #end - var t = cs.system.Type._GetType(name); - #if !CF - if (Object.ReferenceEquals(t, null)) { - var all = cs.system.AppDomain.CurrentDomain.GetAssemblies().GetEnumerator(); - while (all.MoveNext()) { - var t2:cs.system.reflection.Assembly = all.Current; - t = t2.GetType(name); - if (!Object.ReferenceEquals(t, null)) - break; - } - } - #end - if (Object.ReferenceEquals(t, null)) { - switch (name) { - case #if no_root "haxe.root.Int" #else "Int" #end: - return cast Int; - case #if no_root "haxe.root.Float" #else "Float" #end: - return cast Float; - case #if no_root "haxe.root.Class" #else "Class" #end: - return cast Class; - case #if no_root "haxe.root.Dynamic" #else "Dynamic" #end: - return cast Dynamic; - case #if no_root "haxe.root.String" #else "String" #end: - return cast String; - case #if no_root "haxe.root.Bool" #else "Bool" #end: - return cast Bool; - default: - return null; - } - #if !erase_generics - } - else if (t.IsInterface && cast(IGenericObject, cs.system.Type).IsAssignableFrom(t)) { - for (attr in t.GetCustomAttributes(true)) { - var g = cs.Lib.as(attr, cs.internal.HxObject.GenericInterface); - if (g != null) - return Lib.fromNativeType(g.generic); - } - - return Lib.fromNativeType(t); - #end - } else { - return Lib.fromNativeType(t); - } - } - - public static function resolveEnum(name:String):Enum { - var t = Lib.toNativeType(resolveClass(name)); - if (!Object.ReferenceEquals(t, null) - && untyped t.BaseType.Equals(Lib.toNativeType(cs.system.Enum)) || Lib.toNativeType(HxEnum).IsAssignableFrom(t)) - return cast t; - return null; - } - - public static function createInstance(cl:Class, args:Array):T { - if (Object.ReferenceEquals(cl, String)) - return args[0]; - var t = Lib.toNativeType(cl); - if (t.IsInterface) { - // may be generic - t = Lib.toNativeType(resolveClass(getClassName(cl))); - } - var ctors = t.GetConstructors(); - return Runtime.callMethod(null, cast ctors, ctors.Length, cs.Lib.nativeArray(args, true)); - } - - // cache empty constructor arguments so we don't allocate it on each createEmptyInstance call - @:protected @:readOnly static var __createEmptyInstance_EMPTY_ARGS = cs.NativeArray.make((cs.internal.Runtime.EmptyObject.EMPTY : Any)); - - public static function createEmptyInstance(cl:Class):T { - var t = Lib.toNativeType(cl); - - if (cs.system.Object.ReferenceEquals(t, String)) - #if erase_generics - return untyped ""; - #else - return untyped __cs__("(T)(object){0}", ""); - #end - - var res = try cs.system.Activator.CreateInstance(t, - __createEmptyInstance_EMPTY_ARGS) catch (_:cs.system.MissingMemberException) cs.system.Activator.CreateInstance(t); - - #if erase_generics - return res; - #else - return untyped __cs__("(T){0}", res); - #end - } - - public static function createEnum(e:Enum, constr:String, ?params:Array):T { - if (params == null || params.length == 0) { - var ret = cs.internal.Runtime.slowGetField(e, constr, true); - if (Reflect.isFunction(ret)) - throw 'Constructor $constr needs parameters'; - return ret; - } else { - return cs.internal.Runtime.slowCallField(e, constr, cs.Lib.nativeArray(params, true)); - } - } - - public static function createEnumIndex(e:Enum, index:Int, ?params:Array):T { - var constr = getEnumConstructs(e); - return createEnum(e, constr[index], params); - } - - public static function getInstanceFields(c:Class):Array { - if (c == String) - return cs.internal.StringExt.StringRefl.fields; - - var c = cs.Lib.toNativeType(c); - var ret = []; - var mis = c.GetMembers(new cs.Flags(BindingFlags.Public) | BindingFlags.Instance | BindingFlags.FlattenHierarchy); - for (i in 0...mis.Length) { - var i = mis[i]; - if (Std.isOfType(i, PropertyInfo)) - continue; - var n = i.Name; - if (!n.startsWith('__hx_') && n.fastCodeAt(0) != '.'.code) { - switch (n) { - case 'Equals' | 'ToString' | 'GetHashCode' | 'GetType': - case _: - ret.push(n); - } - } - } - return ret; - } - - public static function getClassFields(c:Class):Array { - if (Object.ReferenceEquals(c, String)) { - return ['fromCharCode']; - } - - var ret = []; - var infos = Lib.toNativeType(c).GetMembers(new Flags(BindingFlags.Public) | BindingFlags.Static); - for (i in 0...infos.Length) { - var name = infos[i].Name; - if (!name.startsWith('__hx_')) { - ret.push(name); - } - } - return ret; - } - - public static function getEnumConstructs(e:Enum):Array { - var t = cs.Lib.as(e, cs.system.Type); - var f = t.GetField("__hx_constructs", new cs.Flags(BindingFlags.Static) | BindingFlags.NonPublic); - if (f != null) { - var values:cs.system.Array = f.GetValue(null); - var copy = new cs.NativeArray(values.Length); - cs.system.Array.Copy(values, copy, values.Length); - return cs.Lib.array(copy); - } else - return cs.Lib.array(cs.system.Enum.GetNames(t)); - } - - public static function typeof(v:Dynamic):ValueType { - if (v == null) - return ValueType.TNull; - - var t = cs.Lib.as(v, cs.system.Type); - if (!Object.ReferenceEquals(t, null)) { - // class type - return ValueType.TObject; - } - - t = v.GetType(); - if (t.IsEnum) - return ValueType.TEnum(cast t); - if (Std.isOfType(v, HxEnum)) - return ValueType.TEnum(cast t.BaseType); // enum constructors are subclasses of an enum type - if (t.IsValueType) { - var vc = Std.downcast(v, cs.system.IConvertible); - if (vc != null) { - switch (vc.GetTypeCode()) { - case cs.system.TypeCode.Boolean: - return ValueType.TBool; - case cs.system.TypeCode.Double: - var d:Float = vc.ToDouble(null); - if (d >= cs.system.Int32.MinValue && d <= cs.system.Int32.MaxValue && d == vc.ToInt32(null)) - return ValueType.TInt; - else - return ValueType.TFloat; - case cs.system.TypeCode.Int32: - return ValueType.TInt; - default: - return ValueType.TClass(cast t); - } - } else { - return ValueType.TClass(cast t); - } - } - - if (Std.isOfType(v, IHxObject)) { - if (Std.isOfType(v, DynamicObject)) - return ValueType.TObject; - return ValueType.TClass(cast t); - } else if (Std.isOfType(v, Function)) { - return ValueType.TFunction; - } else { - return ValueType.TClass(cast t); - } - } - - @:ifFeature("has_enum") - public static function enumEq(a:T, b:T):Bool { - if (a == null) - return b == null; - else if (b == null) - return false; - else - return untyped a.Equals(b); - } - - public static function enumConstructor(e:EnumValue):String { - return Std.isOfType(e, cs.system.Enum) ? cast(e, cs.system.Enum).ToString() : cast(e, HxEnum).getTag(); - } - - public static function enumParameters(e:EnumValue):Array { - return Std.isOfType(e, cs.system.Enum) ? [] : cast(e, HxEnum).getParams(); - } - - @:ifFeature("has_enum") - @:pure - public static function enumIndex(e:EnumValue):Int { - if (Std.isOfType(e, cs.system.Enum)) { - var values = cs.system.Enum.GetValues(Lib.getNativeType(e)); - return cs.system.Array.IndexOf(values, e); - } else { - return @:privateAccess cast(e, HxEnum)._hx_index; - } - } - - public static function allEnums(e:Enum):Array { - var ctors = getEnumConstructs(e); - var ret = []; - for (ctor in ctors) { - var v = Reflect.field(e, ctor); - if (Std.isOfType(v, e)) - ret.push(v); - } - - return ret; - } -} diff --git a/std/cs/_std/haxe/Exception.hx b/std/cs/_std/haxe/Exception.hx deleted file mode 100644 index 785551b4873..00000000000 --- a/std/cs/_std/haxe/Exception.hx +++ /dev/null @@ -1,118 +0,0 @@ -package haxe; - -import cs.system.Exception as CsException; -import cs.system.diagnostics.StackTrace; - -@:coreApi -class Exception extends NativeException { - public var message(get,never):String; - public var stack(get,never):CallStack; - public var previous(get,never):Null; - public var native(get,never):Any; - - @:noCompletion var __exceptionStack:Null; - @:noCompletion var __nativeStack:StackTrace; - @:noCompletion var __ownStack:Bool; - @:noCompletion @:ifFeature("haxe.Exception.get_stack") var __skipStack:Int = 0; - @:noCompletion var __nativeException:CsException; - @:noCompletion var __previousException:Null; - - static public function caught(value:Any):Exception { - if(Std.isOfType(value, Exception)) { - return value; - } else if(Std.isOfType(value, CsException)) { - return new Exception((value:CsException).Message, null, value); - } else { - return new ValueException(value, null, value); - } - } - - static public function thrown(value:Any):Any { - if(Std.isOfType(value, Exception)) { - return (value:Exception).native; - } else if(Std.isOfType(value, CsException)) { - return value; - } else { - var e = new ValueException(value); - e.__shiftStack(); - return e; - } - } - - public function new(message:String, ?previous:Exception, ?native:Any) { - super(message, previous); - this.__previousException = previous; - - if(native != null && Std.isOfType(native, CsException)) { - __nativeException = native; - if(__nativeException.StackTrace == null) { - __nativeStack = new StackTrace(1, true); - __ownStack = true; - } else { - __nativeStack = new StackTrace(__nativeException, true); - __ownStack = false; - } - } else { - __nativeException = cast this; - __nativeStack = new StackTrace(1, true); - __ownStack = true; - } - } - - public function unwrap():Any { - return __nativeException; - } - - public function toString():String { - return message; - } - - public function details():String { - return inline CallStack.exceptionToString(this); - } - - @:noCompletion - @:ifFeature("haxe.Exception.get_stack") - inline function __shiftStack():Void { - if(__ownStack) __skipStack++; - } - - function get_message():String { - return this.Message; - } - - function get_previous():Null { - return __previousException; - } - - final function get_native():Any { - return __nativeException; - } - - function get_stack():CallStack { - return switch __exceptionStack { - case null: - __exceptionStack = NativeStackTrace.toHaxe(__nativeStack, __skipStack); - case s: s; - } - } -} - -@:dox(hide) -@:nativeGen -@:noCompletion -@:native('System.Exception') -private extern class NativeException { - @:noCompletion private function new(message:String, innerException:NativeException):Void; - @:noCompletion @:skipReflection private final Data:cs.system.collections.IDictionary; - @:noCompletion @:skipReflection private var HelpLink:String; - @:noCompletion @:skipReflection private final InnerException:cs.system.Exception; - @:noCompletion @:skipReflection private final Message:String; - @:noCompletion @:skipReflection private var Source:String; - @:noCompletion @:skipReflection private final StackTrace:String; - @:noCompletion @:skipReflection private final TargetSite:cs.system.reflection.MethodBase; - @:overload @:noCompletion @:skipReflection private function GetBaseException():cs.system.Exception; - @:overload @:noCompletion @:skipReflection private function GetObjectData(info:cs.system.runtime.serialization.SerializationInfo, context:cs.system.runtime.serialization.StreamingContext):Void; - @:overload @:noCompletion @:skipReflection private function GetType():cs.system.Type; - @:overload @:noCompletion @:skipReflection private function ToString():cs.system.String; -} \ No newline at end of file diff --git a/std/cs/_std/haxe/Int64.hx b/std/cs/_std/haxe/Int64.hx deleted file mode 100644 index 072b1cb0651..00000000000 --- a/std/cs/_std/haxe/Int64.hx +++ /dev/null @@ -1,242 +0,0 @@ -/* - * 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; - -using haxe.Int64; - -import haxe.Int64Helper; - -private typedef __Int64 = cs.StdTypes.Int64; - -@:coreApi -@:transitive -abstract Int64(__Int64) from __Int64 to __Int64 { - public static inline function make(high:Int32, low:Int32):Int64 - return new Int64((cast(high, __Int64) << 32) | (cast(low, __Int64) & (untyped __cs__('0xffffffffL') : Int64))); - - private inline function new(x:__Int64) - this = x; - - private var val(get, set):__Int64; - - inline function get_val():__Int64 - return this; - - inline function set_val(x:__Int64):__Int64 - return this = x; - - public var high(get, never):Int32; - - inline function get_high():Int32 - return cast(this >> 32); - - public var low(get, never):Int32; - - inline function get_low():Int32 - return cast this; - - public inline function copy():Int64 - return new Int64(this); - - @:from public static inline function ofInt(x:Int):Int64 - return cast x; - - public static inline function toInt(x:Int64):Int { - if (x.val < 0x80000000 || x.val > 0x7FFFFFFF) - throw "Overflow"; - return cast x.val; - } - - @:deprecated('haxe.Int64.is() is deprecated. Use haxe.Int64.isInt64() instead') - inline public static function is(val:Dynamic):Bool - return Std.isOfType(val, cs.system.Int64); - - inline public static function isInt64(val:Dynamic):Bool - return Std.isOfType(val, cs.system.Int64); - - public static inline function getHigh(x:Int64):Int32 - return cast(x.val >> 32); - - public static inline function getLow(x:Int64):Int32 - return cast(x.val); - - public static inline function isNeg(x:Int64):Bool - return x.val < 0; - - public static inline function isZero(x:Int64):Bool - return x.val == 0; - - public static inline function compare(a:Int64, b:Int64):Int { - if (a.val < b.val) - return -1; - if (a.val > b.val) - return 1; - return 0; - } - - public static inline function ucompare(a:Int64, b:Int64):Int { - if (a.val < 0) - return (b.val < 0) ? compare(a, b) : 1; - return (b.val < 0) ? -1 : compare(a, b); - } - - public static inline function toStr(x:Int64):String - return '${x.val}'; - - public static inline function divMod(dividend:Int64, divisor:Int64):{quotient:Int64, modulus:Int64} - return {quotient: dividend / divisor, modulus: dividend % divisor}; - - private inline function toString():String - return '$this'; - - public static function parseString(sParam:String):Int64 { - return Int64Helper.parseString(sParam); - } - - public static function fromFloat(f:Float):Int64 { - return Int64Helper.fromFloat(f); - } - - @:op(-A) public static function neg(x:Int64):Int64 - return -x.val; - - @:op(++A) private inline function preIncrement():Int64 - return ++this; - - @:op(A++) private inline function postIncrement():Int64 - return this++; - - @:op(--A) private inline function preDecrement():Int64 - return --this; - - @:op(A--) private inline function postDecrement():Int64 - return this--; - - @:op(A + B) public static inline function add(a:Int64, b:Int64):Int64 - return a.val + b.val; - - @:op(A + B) @:commutative private static inline function addInt(a:Int64, b:Int):Int64 - return a.val + b; - - @:op(A - B) public static inline function sub(a:Int64, b:Int64):Int64 - return a.val - b.val; - - @:op(A - B) private static inline function subInt(a:Int64, b:Int):Int64 - return a.val - b; - - @:op(A - B) private static inline function intSub(a:Int, b:Int64):Int64 - return a - b.val; - - @:op(A * B) public static inline function mul(a:Int64, b:Int64):Int64 - return a.val * b.val; - - @:op(A * B) @:commutative private static inline function mulInt(a:Int64, b:Int):Int64 - return a.val * b; - - @:op(A / B) public static inline function div(a:Int64, b:Int64):Int64 - return a.val / b.val; - - @:op(A / B) private static inline function divInt(a:Int64, b:Int):Int64 - return a.val / b; - - @:op(A / B) private static inline function intDiv(a:Int, b:Int64):Int64 - return a / b.val; - - @:op(A % B) public static inline function mod(a:Int64, b:Int64):Int64 - return a.val % b.val; - - @:op(A % B) private static inline function modInt(a:Int64, b:Int):Int64 - return a.val % b; - - @:op(A % B) private static inline function intMod(a:Int, b:Int64):Int64 - return a % b.val; - - @:op(A == B) public static inline function eq(a:Int64, b:Int64):Bool - return a.val == b.val; - - @:op(A == B) @:commutative private static inline function eqInt(a:Int64, b:Int):Bool - return a.val == b; - - @:op(A != B) public static inline function neq(a:Int64, b:Int64):Bool - return a.val != b.val; - - @:op(A != B) @:commutative private static inline function neqInt(a:Int64, b:Int):Bool - return a.val != b; - - @:op(A < B) private static inline function lt(a:Int64, b:Int64):Bool - return a.val < b.val; - - @:op(A < B) private static inline function ltInt(a:Int64, b:Int):Bool - return a.val < b; - - @:op(A < B) private static inline function intLt(a:Int, b:Int64):Bool - return a < b.val; - - @:op(A <= B) private static inline function lte(a:Int64, b:Int64):Bool - return a.val <= b.val; - - @:op(A <= B) private static inline function lteInt(a:Int64, b:Int):Bool - return a.val <= b; - - @:op(A <= B) private static inline function intLte(a:Int, b:Int64):Bool - return a <= b.val; - - @:op(A > B) private static inline function gt(a:Int64, b:Int64):Bool - return a.val > b.val; - - @:op(A > B) private static inline function gtInt(a:Int64, b:Int):Bool - return a.val > b; - - @:op(A > B) private static inline function intGt(a:Int, b:Int64):Bool - return a > b.val; - - @:op(A >= B) private static inline function gte(a:Int64, b:Int64):Bool - return a.val >= b.val; - - @:op(A >= B) private static inline function gteInt(a:Int64, b:Int):Bool - return a.val >= b; - - @:op(A >= B) private static inline function intGte(a:Int, b:Int64):Bool - return a >= b.val; - - @:op(~A) private static inline function complement(x:Int64):Int64 - return ~x.val; - - @:op(A & B) public static inline function and(a:Int64, b:Int64):Int64 - return a.val & b.val; - - @:op(A | B) public static inline function or(a:Int64, b:Int64):Int64 - return a.val | b.val; - - @:op(A ^ B) public static inline function xor(a:Int64, b:Int64):Int64 - return a.val ^ b.val; - - @:op(A << B) public static inline function shl(a:Int64, b:Int):Int64 - return a.val << b; - - @:op(A >> B) public static inline function shr(a:Int64, b:Int):Int64 - return a.val >> b; - - @:op(A >>> B) public static inline function ushr(a:Int64, b:Int):Int64 - return cast((a.val : cs.StdTypes.UInt64) >> b); -} diff --git a/std/cs/_std/haxe/NativeStackTrace.hx b/std/cs/_std/haxe/NativeStackTrace.hx deleted file mode 100644 index e3e7d0f4965..00000000000 --- a/std/cs/_std/haxe/NativeStackTrace.hx +++ /dev/null @@ -1,60 +0,0 @@ -package haxe; - -import haxe.CallStack.StackItem; -import cs.system.diagnostics.StackTrace; - -/** - Do not use manually. -**/ -@:dox(hide) -@:noCompletion -class NativeStackTrace { - @:meta(System.ThreadStaticAttribute) - static var exception:Null; - - @:ifFeature('haxe.NativeStackTrace.exceptionStack') - static public inline function saveStack(e:Any):Void { - exception = e; - } - - static public inline function callStack():StackTrace { - return new StackTrace(1, true); - } - - static public function exceptionStack():Null { - return switch exception { - case null: null; - case e: new StackTrace(e, true); - } - } - - static public function toHaxe(native:Null, skip:Int = 0):Array { - var stack = []; - if(native == null) { - return stack; - } - var cnt = 0; - for (i in 0...native.FrameCount) { - var frame = native.GetFrame(i); - var m = frame.GetMethod(); - - if (m == null) { - continue; - } - if(skip > cnt++) { - continue; - } - - var method = StackItem.Method(m.ReflectedType.ToString(), m.Name); - - var fileName = frame.GetFileName(); - var lineNumber = frame.GetFileLineNumber(); - - if (fileName != null || lineNumber >= 0) - stack.push(FilePos(method, fileName, lineNumber)); - else - stack.push(method); - } - return stack; - } -} \ No newline at end of file diff --git a/std/cs/_std/haxe/Resource.hx b/std/cs/_std/haxe/Resource.hx deleted file mode 100644 index bbf50909096..00000000000 --- a/std/cs/_std/haxe/Resource.hx +++ /dev/null @@ -1,70 +0,0 @@ -/* - * 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; - -@:coreApi class Resource { - @:keep static var content:Array; - static var paths:Map; - - @:keep static function getPaths():Map { - if (paths != null) - return paths; - - var p = new Map(); - var all = cs.Lib.toNativeType(haxe.Resource).Assembly.GetManifestResourceNames(); - for (i in 0...all.Length) { - var path = all[i]; - var name = path.substr(path.indexOf("Resources.") + 10); - p.set(name, path); - } - return paths = p; - } - - public static inline function listNames():Array { - return content.copy(); - } - - @:access(haxe.io.Path.escape) - public static function getString(name:String):String { - name = haxe.io.Path.escape(name, true); - var path = getPaths().get(name); - if (path == null) - return null; - var str = cs.Lib.toNativeType(haxe.Resource).Assembly.GetManifestResourceStream(path); - if (str != null) - return new cs.io.NativeInput(str).readAll().toString(); - return null; - } - - @:access(haxe.io.Path.escape) - public static function getBytes(name:String):haxe.io.Bytes { - name = haxe.io.Path.escape(name, true); - var path = getPaths().get(name); - if (path == null) - return null; - var str = cs.Lib.toNativeType(haxe.Resource).Assembly.GetManifestResourceStream(path); - if (str != null) - return new cs.io.NativeInput(str).readAll(); - return null; - } -} diff --git a/std/cs/_std/haxe/Rest.hx b/std/cs/_std/haxe/Rest.hx deleted file mode 100644 index ea830bb84f5..00000000000 --- a/std/cs/_std/haxe/Rest.hx +++ /dev/null @@ -1,60 +0,0 @@ -package haxe; - -import cs.NativeArray; -import cs.system.Array as CsArray; -import haxe.iterators.RestIterator; -import haxe.iterators.RestKeyValueIterator; - -private typedef NativeRest = #if erase_generics NativeArray #else NativeArray #end; - -@:coreApi -abstract Rest(NativeRest) { - public var length(get, never):Int; - - inline function get_length():Int - return this.Length; - - @:from static public inline function of(array:Array):Rest - #if erase_generics - // This is wrong but so is everything else in my life - return new Rest(@:privateAccess array.__a); - #else - return new Rest(cs.Lib.nativeArray(array, false)); - #end - - inline function new(a:NativeRest):Void - this = a; - - @:arrayAccess inline function get(index:Int):T - return (this[index] : T); // typecheck, otherwise it will be inlined as Dynamic with `-D erase-generics` - - @:to public function toArray():Array { - var result = new NativeRest(this.Length); - CsArray.Copy(this, 0, result, 0, this.Length); - return @:privateAccess Array.ofNative(result); - } - - public inline function iterator():RestIterator - return new RestIterator(this); - - public inline function keyValueIterator():RestKeyValueIterator - return new RestKeyValueIterator(this); - - public function append(item:T):Rest { - var result = new NativeRest(this.Length + 1); - CsArray.Copy(this, 0, result, 0, this.Length); - result[this.Length] = item; - return new Rest(result); - } - - public function prepend(item:T):Rest { - var result = new NativeRest(this.Length + 1); - CsArray.Copy(this, 0, result, 1, this.Length); - result[0] = item; - return new Rest(result); - } - - public function toString():String { - return toArray().toString(); - } -} diff --git a/std/cs/_std/haxe/atomic/AtomicInt.hx b/std/cs/_std/haxe/atomic/AtomicInt.hx deleted file mode 100644 index d1b9e661aff..00000000000 --- a/std/cs/_std/haxe/atomic/AtomicInt.hx +++ /dev/null @@ -1,61 +0,0 @@ -package haxe.atomic; - -private class IntWrapper { - public var value:Int; - - public function new(value:Int) { - this.value = value; - } -} - -abstract AtomicInt(IntWrapper) { - public inline function new(value:Int) { - this = new IntWrapper(value); - } - - private inline function cas_loop(value:Int, op:(a:Int, b:Int) -> Int):Int { - var oldValue; - var newValue; - do { - oldValue = load(); - newValue = op(oldValue, value); - } while(compareExchange(oldValue, newValue) != oldValue); - return oldValue; - } - - public inline function add(b:Int):Int { - return cas_loop(b, (a, b) -> a + b); - } - - public inline function sub(b:Int):Int { - return cas_loop(b, (a, b) -> a - b); - } - - public inline function and(b:Int):Int { - return cas_loop(b, (a, b) -> cast a & b); - } - - public inline function or(b:Int):Int { - return cas_loop(b, (a, b) -> cast a | b); - } - - public inline function xor(b:Int):Int { - return cas_loop(b, (a, b) -> cast a ^ b); - } - - public inline function compareExchange(expected:Int, replacement:Int):Int { - return cs.Syntax.code("System.Threading.Interlocked.CompareExchange(ref ({0}).value, {1}, {2})", this, replacement, expected); - } - - public inline function exchange(value:Int):Int { - return cs.Syntax.code("System.Threading.Interlocked.Exchange(ref ({0}).value, {1})", this, value); - } - - public inline function load():Int { - return this.value; // according to the CLI spec reads and writes are atomic - } - - public inline function store(value:Int):Int { - return this.value = value; // according to the CLI spec reads and writes are atomic - } -} \ No newline at end of file diff --git a/std/cs/_std/haxe/atomic/AtomicObject.hx b/std/cs/_std/haxe/atomic/AtomicObject.hx deleted file mode 100644 index c7a07bc4cd3..00000000000 --- a/std/cs/_std/haxe/atomic/AtomicObject.hx +++ /dev/null @@ -1,33 +0,0 @@ -package haxe.atomic; - -import cs.system.threading.Interlocked.*; - -private class ObjectWrapper { - public var value:T; - - public function new(value:T) { - this.value = value; - } -} - -extern abstract AtomicObject(ObjectWrapper) { - public inline function new(value:T) { - this = new ObjectWrapper(value); - } - - public inline function compareExchange(expected:T, replacement:T):T { - return cs.Syntax.code("System.Threading.Interlocked.CompareExchange(ref ({0}).value, {1}, {2})", this, replacement, expected); - } - - public inline function exchange(value:T):T { - return cs.Syntax.code("System.Threading.Interlocked.Exchange(ref ({0}).value, {1})", this, value); - } - - public inline function load():T { - return this.value; // according to the CLI spec reads and writes are atomic - } - - public inline function store(value:T):T { - return this.value = value; // according to the CLI spec reads and writes are atomic - } -} \ No newline at end of file diff --git a/std/cs/_std/haxe/ds/IntMap.hx b/std/cs/_std/haxe/ds/IntMap.hx deleted file mode 100644 index 5f936de6a26..00000000000 --- a/std/cs/_std/haxe/ds/IntMap.hx +++ /dev/null @@ -1,528 +0,0 @@ -/* - * 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; - -import cs.NativeArray; - -/* - * This IntMap implementation is based on khash (https://github.com/attractivechaos/klib/blob/master/khash.h) - * Copyright goes to Attractive Chaos and his contributors - * - * Thanks also to Jonas Malaco Filho for his Haxe-written IntMap code inspired by Python tables. - * (https://jonasmalaco.com/fossil/test/jonas-haxe/artifact/887b53126e237d6c68951111d594033403889304) - */ -@:coreApi class IntMap implements haxe.Constraints.IMap { - private static inline var HASH_UPPER = 0.7; - - private var flags:NativeArray; - private var _keys:NativeArray; - private var vals:NativeArray; - - private var nBuckets:Int; - private var size:Int; - private var nOccupied:Int; - private var upperBound:Int; - - #if !no_map_cache - private var cachedKey:Int; - private var cachedIndex:Int; - #end - - public function new():Void { - #if !no_map_cache - cachedIndex = -1; - #end - } - - public function set(key:Int, value:T):Void { - var targetIndex:Int; - if (nOccupied >= upperBound) { - if (nBuckets > (size << 1)) { - resize(nBuckets - 1); // clear "deleted" elements - } else { - resize(nBuckets + 1); - } - } - - var flags = flags, _keys = _keys; - { - var mask = nBuckets - 1, - hashedKey = hash(key), - curIndex = hashedKey & mask; - - var delKey = -1, curFlag = 0; - // to speed things up, don't loop if the first bucket is already free - if (isEmpty(getFlag(flags, curIndex))) { - targetIndex = curIndex; - } else { - var inc = getInc(hashedKey, mask), last = curIndex; - while (!(_keys[curIndex] == key || isEmpty(curFlag = getFlag(flags, curIndex)))) { - if (delKey == -1 && isDel(curFlag)) { - delKey = curIndex; - } - curIndex = (curIndex + inc) & mask; - #if debug - assert(curIndex != last); - #end - } - - if (delKey != -1 && isEmpty(getFlag(flags, curIndex))) { - targetIndex = delKey; - } else { - targetIndex = curIndex; - } - } - } - - var flag = getFlag(flags, targetIndex); - if (isEmpty(flag)) { - _keys[targetIndex] = key; - vals[targetIndex] = value; - setIsBothFalse(flags, targetIndex); - size++; - nOccupied++; - } else if (isDel(flag)) { - _keys[targetIndex] = key; - vals[targetIndex] = value; - setIsBothFalse(flags, targetIndex); - size++; - } else { - #if debug - assert(_keys[targetIndex] == key); - #end - vals[targetIndex] = value; - } - } - - final private function lookup(key:Int):Int { - if (nBuckets != 0) { - var flags = flags, _keys = _keys; - - var mask = nBuckets - 1, - k = hash(key), - index = k & mask, - curFlag = -1, - inc = getInc(k, mask), /* inc == 1 for linear probing */ - last = index; - do { - if (_keys[index] == key) { - if (isEmpty(curFlag = getFlag(flags, index))) { - index = (index + inc) & mask; - continue; - } else if (isDel(curFlag)) { - return -1; - } else { - return index; - } - } else { - index = (index + inc) & mask; - } - } while (index != last); - } - - return -1; - } - - public function get(key:Int):Null { - var idx = -1; - #if !no_map_cache - if (cachedKey == key && ((idx = cachedIndex) != -1)) { - return vals[idx]; - } - #end - - idx = lookup(key); - if (idx != -1) { - #if !no_map_cache - cachedKey = key; - cachedIndex = idx; - #end - return vals[idx]; - } - - return null; - } - - private function getDefault(key:Int, def:T):T { - var idx = -1; - #if !no_map_cache - if (cachedKey == key && ((idx = cachedIndex) != -1)) { - return vals[idx]; - } - #end - - idx = lookup(key); - if (idx != -1) { - #if !no_map_cache - cachedKey = key; - cachedIndex = idx; - #end - return vals[idx]; - } - - return def; - } - - public function exists(key:Int):Bool { - var idx = -1; - #if !no_map_cache - if (cachedKey == key && ((idx = cachedIndex) != -1)) { - return true; - } - #end - - idx = lookup(key); - if (idx != -1) { - #if !no_map_cache - cachedKey = key; - cachedIndex = idx; - #end - - return true; - } - - return false; - } - - public function remove(key:Int):Bool { - var idx = -1; - #if !no_map_cache - if (!(cachedKey == key && ((idx = cachedIndex) != -1))) - #end - { - idx = lookup(key); - } - - if (idx == -1) { - return false; - } else { - #if !no_map_cache - if (cachedKey == key) { - cachedIndex = -1; - } - #end - if (!isEither(getFlag(flags, idx))) { - setIsDelTrue(flags, idx); - --size; - - vals[idx] = null; - // we do NOT reset the keys here, as unlike StringMap, we check for keys equality - // and stop if we find a key that is equal to the one we're looking for - // setting this to 0 will allow the hash to contain duplicate `0` keys - // (see #6457) - // _keys[idx] = 0; - } - - return true; - } - } - - final private function resize(newNBuckets:Int):Void { - // This function uses 0.25*n_bucktes bytes of working space instead of [sizeof(key_t+val_t)+.25]*n_buckets. - var newFlags = null; - var j = 1; - { - newNBuckets = roundUp(newNBuckets); - if (newNBuckets < 4) - newNBuckets = 4; - if (size >= (newNBuckets * HASH_UPPER + 0.5)) - /* requested size is too small */ { - j = 0; - } else { /* hash table size to be changed (shrink or expand); rehash */ - var nfSize = flagsSize(newNBuckets); - newFlags = new NativeArray(nfSize); - for (i in 0...nfSize) { - newFlags[i] = 0xaaaaaaaa; // isEmpty = true; isDel = false - } - if (nBuckets < newNBuckets) // expand - { - var k = new NativeArray(newNBuckets); - if (_keys != null) { - arrayCopy(_keys, 0, k, 0, nBuckets); - } - _keys = k; - - var v = new NativeArray(newNBuckets); - if (vals != null) { - arrayCopy(vals, 0, v, 0, nBuckets); - } - vals = v; - } // otherwise shrink - } - } - - if (j != 0) { // rehashing is required - #if !no_map_cache - // resetting cache - cachedKey = 0; - cachedIndex = -1; - #end - - j = -1; - var nBuckets = nBuckets, _keys = _keys, vals = vals, flags = flags; - - var newMask = newNBuckets - 1; - while (++j < nBuckets) { - if (!isEither(getFlag(flags, j))) { - var key = _keys[j]; - var val = vals[j]; - - // do not set keys as 0 - see comment about #6457 - // _keys[j] = 0; - vals[j] = cast null; - setIsDelTrue(flags, j); - while (true) - /* kick-out process; sort of like in Cuckoo hashing */ { - var k = hash(key); - var inc = getInc(k, newMask); - var i = k & newMask; - while (!isEmpty(getFlag(newFlags, i))) { - i = (i + inc) & newMask; - } - setIsEmptyFalse(newFlags, i); - - if (i < nBuckets && !isEither(getFlag(flags, i))) - /* kick out the existing element */ { - { - var tmp = _keys[i]; - _keys[i] = key; - key = tmp; - } { - var tmp = vals[i]; - vals[i] = val; - val = tmp; - } - - setIsDelTrue(flags, i); /* mark it as deleted in the old hash table */ - } else { /* write the element and jump out of the loop */ - _keys[i] = key; - vals[i] = val; - break; - } - } - } - } - - if (nBuckets > newNBuckets) - /* shrink the hash table */ { - { - var k = new NativeArray(newNBuckets); - arrayCopy(_keys, 0, k, 0, newNBuckets); - this._keys = k; - } { - var v = new NativeArray(newNBuckets); - arrayCopy(vals, 0, v, 0, newNBuckets); - this.vals = v; - } - } - - this.flags = newFlags; - this.nBuckets = newNBuckets; - this.nOccupied = size; - this.upperBound = Std.int(newNBuckets * HASH_UPPER + .5); - } - } - - public inline function keys():Iterator { - return new IntMapKeyIterator(this); - } - - public inline function iterator():Iterator { - return new IntMapValueIterator(this); - } - - @:runtime public inline function keyValueIterator():KeyValueIterator { - return new haxe.iterators.MapKeyValueIterator(this); - } - - public function copy():IntMap { - var copied = new IntMap(); - for (key in keys()) - copied.set(key, get(key)); - return copied; - } - - public function toString():String { - var s = new StringBuf(); - s.add("["); - var it = keys(); - for (i in it) { - s.add(i); - s.add(" => "); - s.add(Std.string(get(i))); - if (it.hasNext()) - s.add(", "); - } - s.add("]"); - return s.toString(); - } - - public function clear():Void { - flags = null; - _keys = null; - vals = null; - nBuckets = 0; - size = 0; - nOccupied = 0; - upperBound = 0; - #if !no_map_cache - cachedKey = 0; - cachedIndex = -1; - #end - } - - private static inline function assert(x:Bool):Void { - #if debug - if (!x) - throw "assert failed"; - #end - } - - private static inline function defaultK():Int - return 0; - - private static inline function arrayCopy(sourceArray:cs.system.Array, sourceIndex:Int, destinationArray:cs.system.Array, destinationIndex:Int, - length:Int):Void { - cs.system.Array.Copy(sourceArray, sourceIndex, destinationArray, destinationIndex, length); - } - - private static inline function getInc(k:Int, mask:Int):Int { - return (((k) >> 3 ^ (k) << 3) | 1) & (mask); - } - - private static inline function hash(i:Int):Int { - return i; - } - - // flags represents a bit array with 2 significant bits for each index - // one bit for deleted (1), one for empty (2) - // so what this function does is: - // * gets the integer with (flags / 16) - // * shifts those bits to the right ((flags % 16) * 2) places - // * masks it with 0b11 - private static inline function getFlag(flags:NativeArray, i:Int):Int { - return ((flags[i >> 4] >>> ((i & 0xf) << 1)) & 3); - } - - private static inline function isDel(flag:Int):Bool { - return (flag & 1) != 0; - } - - private static inline function isEmpty(flag:Int):Bool { - return (flag & 2) != 0; - } - - private static inline function isEither(flag:Int):Bool { - return flag != 0; - } - - private static inline function setIsDelFalse(flags:NativeArray, i:Int):Void { - flags[i >> 4] &= ~(1 << ((i & 0xf) << 1)); - } - - private static inline function setIsEmptyFalse(flags:NativeArray, i:Int):Void { - flags[i >> 4] &= ~(2 << ((i & 0xf) << 1)); - } - - private static inline function setIsBothFalse(flags:NativeArray, i:Int):Void { - flags[i >> 4] &= ~(3 << ((i & 0xf) << 1)); - } - - private static inline function setIsDelTrue(flags:NativeArray, i:Int):Void { - flags[i >> 4] |= 1 << ((i & 0xf) << 1); - } - - private static inline function roundUp(x:Int):Int { - --x; - x |= (x) >>> 1; - x |= (x) >>> 2; - x |= (x) >>> 4; - x |= (x) >>> 8; - x |= (x) >>> 16; - return ++x; - } - - private static inline function flagsSize(m:Int):Int { - return ((m) < 16 ? 1 : (m) >> 4); - } -} - -@:access(haxe.ds.IntMap) -private final class IntMapKeyIterator { - var m:IntMap; - var i:Int; - var len:Int; - - public function new(m:IntMap) { - this.i = 0; - this.m = m; - this.len = m.nBuckets; - } - - public function hasNext():Bool { - for (j in i...len) { - if (!IntMap.isEither(IntMap.getFlag(m.flags, j))) { - i = j; - return true; - } - } - return false; - } - - public function next():Int { - var ret = m._keys[i]; - #if !no_map_cache - m.cachedIndex = i; - m.cachedKey = ret; - #end - i++; - return ret; - } -} - -@:access(haxe.ds.IntMap) -private final class IntMapValueIterator { - var m:IntMap; - var i:Int; - var len:Int; - - public function new(m:IntMap) { - this.i = 0; - this.m = m; - this.len = m.nBuckets; - } - - public function hasNext():Bool { - for (j in i...len) { - if (!IntMap.isEither(IntMap.getFlag(m.flags, j))) { - i = j; - return true; - } - } - return false; - } - - public inline function next():T { - return m.vals[i++]; - } -} diff --git a/std/cs/_std/haxe/ds/ObjectMap.hx b/std/cs/_std/haxe/ds/ObjectMap.hx deleted file mode 100644 index dd26bb1a6ae..00000000000 --- a/std/cs/_std/haxe/ds/ObjectMap.hx +++ /dev/null @@ -1,539 +0,0 @@ -/* - * 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; - -import cs.NativeArray; - -@:coreApi class ObjectMap implements haxe.Constraints.IMap { - extern private static inline var HASH_UPPER = 0.77; - extern private static inline var FLAG_EMPTY = 0; - extern private static inline var FLAG_DEL = 1; - - /** - * This is the most important structure here and the reason why it's so fast. - * It's an array of all the hashes contained in the table. These hashes cannot be 0 nor 1, - * which stand for "empty" and "deleted" states. - * - * The lookup algorithm will keep looking until a 0 or the key wanted is found; - * The insertion algorithm will do the same but will also break when FLAG_DEL is found; - */ - private var hashes:NativeArray; - - private var _keys:NativeArray; - private var vals:NativeArray; - - private var nBuckets:Int; - private var size:Int; - private var nOccupied:Int; - private var upperBound:Int; - - #if !no_map_cache - private var cachedKey:K; - private var cachedIndex:Int; - #end - - #if DEBUG_HASHTBL - private var totalProbes:Int; - private var probeTimes:Int; - private var sameHash:Int; - private var maxProbe:Int; - #end - - public function new():Void { - #if !no_map_cache - cachedIndex = -1; - #end - } - - public function set(key:K, value:V):Void { - var x:Int, k:Int; - if (nOccupied >= upperBound) { - if (nBuckets > (size << 1)) - resize(nBuckets - 1); // clear "deleted" elements - else - resize(nBuckets + 2); - } - - var hashes = hashes, keys = _keys, hashes = hashes; - { - var mask = (nBuckets == 0) ? 0 : nBuckets - 1; - var site = x = nBuckets; - k = hash(key); - var i = k & mask, nProbes = 0; - - var delKey = -1; - // for speed up - if (isEmpty(hashes[i])) { - x = i; - } else { - // var inc = getInc(k, mask); - var last = i, flag; - while (!(isEmpty(flag = hashes[i]) || (flag == k && _keys[i] == key))) { - if (isDel(flag) && delKey == -1) - delKey = i; - i = (i + ++nProbes) & mask; - #if DEBUG_HASHTBL - probeTimes++; - if (i == last) - throw "assert"; - #end - } - - if (isEmpty(flag) && delKey != -1) - x = delKey; - else - x = i; - } - - #if DEBUG_HASHTBL - if (nProbes > maxProbe) - maxProbe = nProbes; - totalProbes++; - #end - } - - var flag = hashes[x]; - if (isEmpty(flag)) { - keys[x] = key; - vals[x] = value; - hashes[x] = k; - size++; - nOccupied++; - } else if (isDel(flag)) { - keys[x] = key; - vals[x] = value; - hashes[x] = k; - size++; - } else { - assert(_keys[x] == key); - vals[x] = value; - } - - #if !no_map_cache - cachedIndex = x; - cachedKey = key; - #end - } - - private final function lookup(key:K):Int { - if (nBuckets != 0) { - var hashes = hashes, keys = _keys; - - var mask = nBuckets - 1, hash = hash(key), k = hash, nProbes = 0; - var i = k & mask; - var last = i, flag; - // var inc = getInc(k, mask); - while (!isEmpty(flag = hashes[i]) && (isDel(flag) || flag != k || keys[i] != key)) { - i = (i + ++nProbes) & mask; - #if DEBUG_HASHTBL - probeTimes++; - if (i == last) - throw "assert"; - #end - } - - #if DEBUG_HASHTBL - if (nProbes > maxProbe) - maxProbe = nProbes; - totalProbes++; - #end - return isEither(flag) ? -1 : i; - } - - return -1; - } - - final function resize(newNBuckets:Int):Void { - // This function uses 0.25*n_bucktes bytes of working space instead of [sizeof(key_t+val_t)+.25]*n_buckets. - var newHash = null; - var j = 1; - { - newNBuckets = roundUp(newNBuckets); - if (newNBuckets < 4) - newNBuckets = 4; - if (size >= (newNBuckets * HASH_UPPER + 0.5)) - /* requested size is too small */ { - j = 0; - } else { /* hash table size to be changed (shrink or expand); rehash */ - var nfSize = newNBuckets; - newHash = new NativeArray(nfSize); - if (nBuckets < newNBuckets) // expand - { - var k = new NativeArray(newNBuckets); - if (_keys != null) - arrayCopy(_keys, 0, k, 0, nBuckets); - _keys = k; - - var v = new NativeArray(newNBuckets); - if (vals != null) - arrayCopy(vals, 0, v, 0, nBuckets); - vals = v; - } // otherwise shrink - } - } - - if (j != 0) { // rehashing is required - #if !no_map_cache - // resetting cache - cachedKey = null; - cachedIndex = -1; - #end - - j = -1; - var nBuckets = nBuckets, - _keys = _keys, - vals = vals, - hashes = hashes; - - var newMask = newNBuckets - 1; - while (++j < nBuckets) { - var k; - if (!isEither(k = hashes[j])) { - var key = _keys[j]; - var val = vals[j]; - - _keys[j] = null; - vals[j] = cast null; - hashes[j] = FLAG_DEL; - while (true) - /* kick-out process; sort of like in Cuckoo hashing */ { - var nProbes = 0; - // var inc = getInc(k, newMask); - var i = k & newMask; - - while (!isEmpty(newHash[i])) - i = (i + ++nProbes) & newMask; - - newHash[i] = k; - - if (i < nBuckets && !isEither(k = hashes[i])) - /* kick out the existing element */ { - { - var tmp = _keys[i]; - _keys[i] = key; - key = tmp; - } { - var tmp = vals[i]; - vals[i] = val; - val = tmp; - } - - hashes[i] = FLAG_DEL; /* mark it as deleted in the old hash table */ - } else { /* write the element and jump out of the loop */ - _keys[i] = key; - vals[i] = val; - break; - } - } - } - } - - if (nBuckets > newNBuckets) - /* shrink the hash table */ { - { - var k = new NativeArray(newNBuckets); - arrayCopy(_keys, 0, k, 0, newNBuckets); - this._keys = k; - } { - var v = new NativeArray(newNBuckets); - arrayCopy(vals, 0, v, 0, newNBuckets); - this.vals = v; - } - } - - this.hashes = newHash; - this.nBuckets = newNBuckets; - this.nOccupied = size; - this.upperBound = Std.int(newNBuckets * HASH_UPPER + .5); - } - } - - public function get(key:K):Null { - var idx = -1; - #if !no_map_cache - if (cachedKey == key && ((idx = cachedIndex) != -1)) { - return vals[idx]; - } - #end - - idx = lookup(key); - if (idx != -1) { - #if !no_map_cache - cachedKey = key; - cachedIndex = idx; - #end - - return vals[idx]; - } - - return null; - } - - private function getDefault(key:K, def:V):V { - var idx = -1; - #if !no_map_cache - if (cachedKey == key && ((idx = cachedIndex) != -1)) { - return vals[idx]; - } - #end - - idx = lookup(key); - if (idx != -1) { - #if !no_map_cache - cachedKey = key; - cachedIndex = idx; - #end - - return vals[idx]; - } - - return def; - } - - public function exists(key:K):Bool { - var idx = -1; - #if !no_map_cache - if (cachedKey == key && ((idx = cachedIndex) != -1)) { - return true; - } - #end - - idx = lookup(key); - if (idx != -1) { - #if !no_map_cache - cachedKey = key; - cachedIndex = idx; - #end - - return true; - } - - return false; - } - - public function remove(key:K):Bool { - var idx = -1; - #if !no_map_cache - if (!(cachedKey == key && ((idx = cachedIndex) != -1))) - #end - { - idx = lookup(key); - } - - if (idx == -1) { - return false; - } else { - #if !no_map_cache - if (cachedKey == key) - cachedIndex = -1; - #end - - hashes[idx] = FLAG_DEL; - _keys[idx] = null; - vals[idx] = null; - --size; - - return true; - } - } - - public function keys():Iterator { - return new ObjectMapKeyIterator(this); - } - - public function iterator():Iterator { - return new ObjectMapValueIterator(this); - } - - @:runtime public inline function keyValueIterator():KeyValueIterator { - return new haxe.iterators.MapKeyValueIterator(this); - } - - public function copy():ObjectMap { - var copied = new ObjectMap(); - for (key in keys()) - copied.set(key, get(key)); - return copied; - } - - 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 { - hashes = null; - _keys = null; - vals = null; - nBuckets = 0; - size = 0; - nOccupied = 0; - upperBound = 0; - #if !no_map_cache - cachedKey = null; - cachedIndex = -1; - #end - #if DEBUG_HASHTBL - totalProbes = 0; - probeTimes = 0; - sameHash = 0; - maxProbe = 0; - #end - } - - extern private static inline function roundUp(x:Int):Int { - --x; - x |= (x) >>> 1; - x |= (x) >>> 2; - x |= (x) >>> 4; - x |= (x) >>> 8; - x |= (x) >>> 16; - return ++x; - } - - extern private static inline function getInc(k:Int, mask:Int):Int // return 1 for linear probing - return (((k) >> 3 ^ (k) << 3) | 1) & (mask); - - extern private static inline function isEither(v:HashType):Bool - return (v & 0xFFFFFFFE) == 0; - - extern private static inline function isEmpty(v:HashType):Bool - return v == FLAG_EMPTY; - - extern private static inline function isDel(v:HashType):Bool - return v == FLAG_DEL; - - // guarantee: Whatever this function is, it will never return 0 nor 1 - extern private static inline function hash(s:K):HashType { - var k:Int = untyped s.GetHashCode(); - // k *= 357913941; - // k ^= k << 24; - // k += ~357913941; - // k ^= k >> 31; - // k ^= k << 31; - - k = (k + 0x7ed55d16) + (k << 12); - k = (k ^ 0xc761c23c) ^ (k >> 19); - k = (k + 0x165667b1) + (k << 5); - k = (k + 0xd3a2646c) ^ (k << 9); - k = (k + 0xfd7046c5) + (k << 3); - k = (k ^ 0xb55a4f09) ^ (k >> 16); - - var ret = k; - if (isEither(ret)) { - if (ret == 0) - ret = 2; - else - ret = 0xFFFFFFFF; - } - - return ret; - } - - extern private static inline function arrayCopy(sourceArray:cs.system.Array, sourceIndex:Int, destinationArray:cs.system.Array, destinationIndex:Int, - length:Int):Void - cs.system.Array.Copy(sourceArray, sourceIndex, destinationArray, destinationIndex, length); - - extern private static inline function assert(x:Bool):Void { - #if DEBUG_HASHTBL - if (!x) - throw "assert failed"; - #end - } -} - -@:access(haxe.ds.ObjectMap) -private final class ObjectMapKeyIterator { - var m:ObjectMap; - var i:Int; - var len:Int; - - public function new(m:ObjectMap) { - this.i = 0; - this.m = m; - this.len = m.nBuckets; - } - - public function hasNext():Bool { - for (j in i...len) { - if (!ObjectMap.isEither(m.hashes[j])) { - i = j; - return true; - } - } - return false; - } - - public function next():T { - var ret = m._keys[i]; - - #if !no_map_cache - m.cachedIndex = i; - m.cachedKey = ret; - #end - - i = i + 1; - return ret; - } -} - -@:access(haxe.ds.ObjectMap) -private final class ObjectMapValueIterator { - var m:ObjectMap; - var i:Int; - var len:Int; - - public function new(m:ObjectMap) { - this.i = 0; - this.m = m; - this.len = m.nBuckets; - } - - public function hasNext():Bool { - for (j in i...len) { - if (!ObjectMap.isEither(m.hashes[j])) { - i = j; - return true; - } - } - return false; - } - - public inline function next():T { - var ret = m.vals[i]; - i = i + 1; - return ret; - } -} - -private typedef HashType = Int; diff --git a/std/cs/_std/haxe/ds/StringMap.hx b/std/cs/_std/haxe/ds/StringMap.hx deleted file mode 100644 index 39d652dc30c..00000000000 --- a/std/cs/_std/haxe/ds/StringMap.hx +++ /dev/null @@ -1,531 +0,0 @@ -/* - * 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; - -import cs.NativeArray; - -@:coreApi class StringMap implements haxe.Constraints.IMap { - extern private static inline var HASH_UPPER = 0.77; - extern private static inline var FLAG_EMPTY = 0; - extern private static inline var FLAG_DEL = 1; - - /** - * This is the most important structure here and the reason why it's so fast. - * It's an array of all the hashes contained in the table. These hashes cannot be 0 nor 1, - * which stand for "empty" and "deleted" states. - * - * The lookup algorithm will keep looking until a 0 or the key wanted is found; - * The insertion algorithm will do the same but will also break when FLAG_DEL is found; - */ - private var hashes:NativeArray; - - private var _keys:NativeArray; - private var vals:NativeArray; - - private var nBuckets:Int; - private var size:Int; - private var nOccupied:Int; - private var upperBound:Int; - - #if !no_map_cache - private var cachedKey:String; - private var cachedIndex:Int; - #end - - #if DEBUG_HASHTBL - private var totalProbes:Int; - private var probeTimes:Int; - private var sameHash:Int; - private var maxProbe:Int; - #end - - public function new():Void { - #if !no_map_cache - cachedIndex = -1; - #end - } - - public function set(key:String, value:T):Void { - var x:Int, k:Int; - if (nOccupied >= upperBound) { - if (nBuckets > (size << 1)) { - resize(nBuckets - 1); // clear "deleted" elements - } else { - resize(nBuckets + 2); - } - } - - var hashes = hashes, keys = _keys, hashes = hashes; - { - var mask = (nBuckets == 0) ? 0 : nBuckets - 1; - var site = x = nBuckets; - k = hash(key); - var i = k & mask, nProbes = 0; - - var delKey = -1; - // to speed things up, don't loop if the first bucket is already free - if (isEmpty(hashes[i])) { - x = i; - } else { - var last = i, flag; - while (!(isEmpty(flag = hashes[i]) || (flag == k && _keys[i] == key))) { - if (isDel(flag) && delKey == -1) { - delKey = i; - } - i = (i + ++nProbes) & mask; - #if DEBUG_HASHTBL - probeTimes++; - if (i == last) - throw "assert"; - #end - } - - if (isEmpty(flag) && delKey != -1) { - x = delKey; - } else { - x = i; - } - } - - #if DEBUG_HASHTBL - if (nProbes > maxProbe) - maxProbe = nProbes; - totalProbes++; - #end - } - - var flag = hashes[x]; - if (isEmpty(flag)) { - keys[x] = key; - vals[x] = value; - hashes[x] = k; - size++; - nOccupied++; - } else if (isDel(flag)) { - keys[x] = key; - vals[x] = value; - hashes[x] = k; - size++; - } else { - assert(_keys[x] == key); - vals[x] = value; - } - - #if !no_map_cache - cachedIndex = x; - cachedKey = key; - #end - } - - private final function lookup(key:String):Int { - if (nBuckets != 0) { - var hashes = hashes, keys = _keys; - - var mask = nBuckets - 1, hash = hash(key), k = hash, nProbes = 0; - var i = k & mask; - var last = i, flag; - // if we hit an empty bucket, it means we're done - while (!isEmpty(flag = hashes[i]) && (isDel(flag) || flag != k || keys[i] != key)) { - i = (i + ++nProbes) & mask; - #if DEBUG_HASHTBL - probeTimes++; - if (i == last) - throw "assert"; - #end - } - - #if DEBUG_HASHTBL - if (nProbes > maxProbe) - maxProbe = nProbes; - totalProbes++; - #end - return isEither(flag) ? -1 : i; - } - - return -1; - } - - final function resize(newNBuckets:Int):Void { - // This function uses 0.25*n_bucktes bytes of working space instead of [sizeof(key_t+val_t)+.25]*n_buckets. - var newHash = null; - var j = 1; - { - newNBuckets = roundUp(newNBuckets); - if (newNBuckets < 4) - newNBuckets = 4; - if (size >= (newNBuckets * HASH_UPPER + 0.5)) - /* requested size is too small */ { - j = 0; - } else { /* hash table size to be changed (shrink or expand); rehash */ - var nfSize = newNBuckets; - newHash = new NativeArray(nfSize); - if (nBuckets < newNBuckets) // expand - { - var k = new NativeArray(newNBuckets); - if (_keys != null) - arrayCopy(_keys, 0, k, 0, nBuckets); - _keys = k; - - var v = new NativeArray(newNBuckets); - if (vals != null) - arrayCopy(vals, 0, v, 0, nBuckets); - vals = v; - } // otherwise shrink - } - } - - if (j != 0) { // rehashing is required - // resetting cache - #if !no_map_cache - cachedKey = null; - cachedIndex = -1; - #end - - j = -1; - var nBuckets = nBuckets, - _keys = _keys, - vals = vals, - hashes = hashes; - - var newMask = newNBuckets - 1; - while (++j < nBuckets) { - var k; - if (!isEither(k = hashes[j])) { - var key = _keys[j]; - var val = vals[j]; - - _keys[j] = null; - vals[j] = cast null; - hashes[j] = FLAG_DEL; - while (true) - /* kick-out process; sort of like in Cuckoo hashing */ { - var nProbes = 0; - var i = k & newMask; - - while (!isEmpty(newHash[i])) { - i = (i + ++nProbes) & newMask; - } - - newHash[i] = k; - - if (i < nBuckets && !isEither(k = hashes[i])) - /* kick out the existing element */ { - { // inlined swap - var tmp = _keys[i]; - _keys[i] = key; - key = tmp; - } { // inlined swap - var tmp = vals[i]; - vals[i] = val; - val = tmp; - } - - hashes[i] = FLAG_DEL; /* mark it as deleted in the old hash table */ - } else { /* write the element and jump out of the loop */ - _keys[i] = key; - vals[i] = val; - break; - } - } - } - } - - if (nBuckets > newNBuckets) - /* shrink the hash table */ { - { // inlined swap - var k = new NativeArray(newNBuckets); - arrayCopy(_keys, 0, k, 0, newNBuckets); - this._keys = k; - } { // inlined swap - var v = new NativeArray(newNBuckets); - arrayCopy(vals, 0, v, 0, newNBuckets); - this.vals = v; - } - } - - this.hashes = newHash; - this.nBuckets = newNBuckets; - this.nOccupied = size; - this.upperBound = Std.int(newNBuckets * HASH_UPPER + .5); - } - } - - public function get(key:String):Null { - var idx = -1; - #if !no_map_cache - if (cachedKey == key && ((idx = cachedIndex) != -1)) { - return vals[idx]; - } - #end - idx = lookup(key); - if (idx != -1) { - #if !no_map_cache - cachedKey = key; - cachedIndex = idx; - #end - return vals[idx]; - } - - return null; - } - - private function getDefault(key:String, def:T):T { - var idx = -1; - #if !no_map_cache - if (cachedKey == key && ((idx = cachedIndex) != -1)) { - return vals[idx]; - } - #end - - idx = lookup(key); - if (idx != -1) { - #if !no_map_cache - cachedKey = key; - cachedIndex = idx; - #end - - return vals[idx]; - } - - return def; - } - - public function exists(key:String):Bool { - var idx = -1; - #if !no_map_cache - if (cachedKey == key && ((idx = cachedIndex) != -1)) { - return true; - } - #end - - idx = lookup(key); - if (idx != -1) { - #if !no_map_cache - cachedKey = key; - cachedIndex = idx; - #end - return true; - } - - return false; - } - - public function remove(key:String):Bool { - var idx = -1; - #if !no_map_cache - if (!(cachedKey == key && ((idx = cachedIndex) != -1))) - #end - { - idx = lookup(key); - } - - if (idx == -1) { - return false; - } else { - #if !no_map_cache - if (cachedKey == key) { - cachedIndex = -1; - } - #end - hashes[idx] = FLAG_DEL; - _keys[idx] = null; - vals[idx] = null; - --size; - - return true; - } - } - - public inline function keys():Iterator { - return new StringMapKeyIterator(this); - } - - public inline function iterator():Iterator { - return new StringMapValueIterator(this); - } - - @:runtime public inline function keyValueIterator():KeyValueIterator { - return new haxe.iterators.MapKeyValueIterator(this); - } - - public function copy():StringMap { - var copied = new StringMap(); - for (key in keys()) - copied.set(key, get(key)); - return copied; - } - - public function toString():String { - var s = new StringBuf(); - s.add("["); - var it = keys(); - for (i in it) { - s.add(i); - s.add(" => "); - s.add(Std.string(get(i))); - if (it.hasNext()) - s.add(", "); - } - s.add("]"); - return s.toString(); - } - - public function clear():Void { - hashes = null; - _keys = null; - vals = null; - nBuckets = 0; - size = 0; - nOccupied = 0; - upperBound = 0; - #if !no_map_cache - cachedKey = null; - cachedIndex = -1; - #end - #if DEBUG_HASHTBL - totalProbes = 0; - probeTimes = 0; - sameHash = 0; - maxProbe = 0; - #end - } - - extern private static inline function roundUp(x:Int):Int { - --x; - x |= (x) >>> 1; - x |= (x) >>> 2; - x |= (x) >>> 4; - x |= (x) >>> 8; - x |= (x) >>> 16; - return ++x; - } - - extern private static inline function isEither(v:HashType):Bool - return (v & 0xFFFFFFFE) == 0; - - extern private static inline function isEmpty(v:HashType):Bool - return v == FLAG_EMPTY; - - extern private static inline function isDel(v:HashType):Bool - return v == FLAG_DEL; - - // guarantee: Whatever this function is, it will never return 0 nor 1 - extern private static inline function hash(s:String):HashType { - var k:Int = untyped s.GetHashCode(); - // k *= 357913941; - // k ^= k << 24; - // k += ~357913941; - // k ^= k >> 31; - // k ^= k << 31; - - k = (k + 0x7ed55d16) + (k << 12); - k = (k ^ 0xc761c23c) ^ (k >> 19); - k = (k + 0x165667b1) + (k << 5); - k = (k + 0xd3a2646c) ^ (k << 9); - k = (k + 0xfd7046c5) + (k << 3); - k = (k ^ 0xb55a4f09) ^ (k >> 16); - - var ret = k; - if (isEither(ret)) { - if (ret == 0) - ret = 2; - else - ret = 0xFFFFFFFF; - } - - return ret; - } - - extern private static inline function arrayCopy(sourceArray:cs.system.Array, sourceIndex:Int, destinationArray:cs.system.Array, destinationIndex:Int, - length:Int):Void - cs.system.Array.Copy(sourceArray, sourceIndex, destinationArray, destinationIndex, length); - - extern private static inline function assert(x:Bool):Void { - #if DEBUG_HASHTBL - if (!x) - throw "assert failed"; - #end - } -} - -private typedef HashType = Int; - -@:access(haxe.ds.StringMap) -private final class StringMapKeyIterator { - var m:StringMap; - var i:Int; - var len:Int; - - public function new(m:StringMap) { - this.m = m; - this.i = 0; - this.len = m.nBuckets; - } - - public function hasNext():Bool { - for (j in i...len) { - if (!StringMap.isEither(m.hashes[j])) { - i = j; - return true; - } - } - return false; - } - - public function next():String { - var ret = m._keys[i]; - #if !no_map_cache - m.cachedIndex = i; - m.cachedKey = ret; - #end - i++; - return ret; - } -} - -@:access(haxe.ds.StringMap) -private final class StringMapValueIterator { - var m:StringMap; - var i:Int; - var len:Int; - - public function new(m:StringMap) { - this.m = m; - this.i = 0; - this.len = m.nBuckets; - } - - public function hasNext():Bool { - for (j in i...len) { - if (!StringMap.isEither(m.hashes[j])) { - i = j; - return true; - } - } - return false; - } - - public inline function next():T { - return m.vals[i++]; - } -} diff --git a/std/cs/_std/sys/FileSystem.hx b/std/cs/_std/sys/FileSystem.hx deleted file mode 100644 index 8b079654bb5..00000000000 --- a/std/cs/_std/sys/FileSystem.hx +++ /dev/null @@ -1,125 +0,0 @@ -/* - * 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 sys; - -import cs.system.io.DirectoryInfo; -import cs.system.io.File; -import cs.system.io.Directory; -import cs.system.io.FileInfo; - -@:coreApi -class FileSystem { - public static function exists(path:String):Bool { - return (File.Exists(path) || Directory.Exists(path)); - } - - public static function rename(path:String, newPath:String):Void { - Directory.Move(path, newPath); - } - - @:access(Date.fromNative) - public static function stat(path:String):FileStat { - if (File.Exists(path)) { - var fi = new FileInfo(path); - return { - gid: 0, // C# doesn't let you get this info - uid: 0, // same - atime: Date.fromNative(fi.LastAccessTime), - mtime: Date.fromNative(fi.LastWriteTime), - ctime: Date.fromNative(fi.CreationTime), - size: cast(fi.Length, Int), // TODO: maybe change to Int64 for Haxe 3? - dev: 0, // FIXME: not sure what that is - ino: 0, // FIXME: not sure what that is - nlink: 0, // FIXME: not sure what that is - rdev: 0, // FIXME: not sure what that is - mode: 0 // FIXME: not sure what that is - }; - } else if (Directory.Exists(path)) { - var fi = new DirectoryInfo(path); - return { - gid: 0, // C# doesn't let you get this info - uid: 0, // same - atime: Date.fromNative(fi.LastAccessTime), - mtime: Date.fromNative(fi.LastWriteTime), - ctime: Date.fromNative(fi.CreationTime), - size: 0, // TODO: maybe change to Int64 for Haxe 3? - dev: 0, // FIXME: not sure what that is - ino: 0, // FIXME: not sure what that is - nlink: 0, // FIXME: not sure what that is - rdev: 0, // FIXME: not sure what that is - mode: 0 // FIXME: not sure what that is - }; - } else { - throw "Path '" + path + "' doesn't exist"; - } - } - - public static function fullPath(relPath:String):String { - return new FileInfo(relPath).FullName; - } - - public static function absolutePath(relPath:String):String { - if (haxe.io.Path.isAbsolute(relPath)) - return relPath; - return haxe.io.Path.join([Sys.getCwd(), relPath]); - } - - public static function isDirectory(path:String):Bool { - var isdir = Directory.Exists(path); - if (isdir != File.Exists(path)) - return isdir; - throw "Path '" + path + "' doesn't exist"; - } - - public static function createDirectory(path:String):Void { - Directory.CreateDirectory(path); - } - - public static function deleteFile(path:String):Void { - if (!File.Exists(path)) - throw "Path '" + path + "' doesn't exist"; - File.Delete(path); - } - - public static function deleteDirectory(path:String):Void { - if (!Directory.Exists(path)) - throw "Path '" + path + "' doesn't exist"; - Directory.Delete(path); - } - - public static function readDirectory(path:String):Array { - var ret = Directory.GetFileSystemEntries(path); - if (ret.Length > 0) { - var fst = ret[0]; - var sep = "/"; - if (fst.lastIndexOf(sep) < fst.lastIndexOf("\\")) - sep = "\\"; - for (i in 0...ret.Length) { - var path = ret[i]; - ret[i] = path.substr(path.lastIndexOf(sep) + 1); - } - } - - return cs.Lib.array(ret); - } -} diff --git a/std/cs/_std/sys/io/File.hx b/std/cs/_std/sys/io/File.hx deleted file mode 100644 index 680feae3347..00000000000 --- a/std/cs/_std/sys/io/File.hx +++ /dev/null @@ -1,95 +0,0 @@ -/* - * 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 sys.io; - -@:coreApi -class File { - public static function getContent(path:String):String { - var f = read(path, false); - var ret = f.readAll().toString(); - f.close(); - return ret; - } - - public static function saveContent(path:String, content:String):Void { - var f = write(path, false); - f.writeString(content); - f.close(); - } - - public static function getBytes(path:String):haxe.io.Bytes { - var f = read(path, true); - var ret = f.readAll(); - f.close(); - return ret; - } - - public static function saveBytes(path:String, bytes:haxe.io.Bytes):Void { - var f = write(path, true); - f.writeBytes(bytes, 0, bytes.length); - f.close(); - } - - public static function read(path:String, binary:Bool = true):FileInput { - #if std_buffer // standardize 4kb buffers - var stream = new cs.system.io.FileStream(path, Open, Read, ReadWrite, 4096); - #else - var stream = new cs.system.io.FileStream(path, Open, Read, ReadWrite); - #end - return @:privateAccess new FileInput(stream); - } - - public static function write(path:String, binary:Bool = true):FileOutput { - #if std_buffer // standardize 4kb buffers - var stream = new cs.system.io.FileStream(path, Create, Write, ReadWrite, 4096); - #else - var stream = new cs.system.io.FileStream(path, Create, Write, ReadWrite); - #end - return @:privateAccess new FileOutput(stream); - } - - public static function append(path:String, binary:Bool = true):FileOutput { - #if std_buffer // standardize 4kb buffers - var stream = new cs.system.io.FileStream(path, Append, Write, ReadWrite, 4096); - #else - var stream = new cs.system.io.FileStream(path, Append, Write, ReadWrite); - #end - return @:privateAccess new FileOutput(stream); - } - - public static function update(path:String, binary:Bool = true):FileOutput { - if (!FileSystem.exists(path)) { - write(path).close(); - } - #if std_buffer // standardize 4kb buffers - var stream = new cs.system.io.FileStream(path, OpenOrCreate, Write, ReadWrite, 4096); - #else - var stream = new cs.system.io.FileStream(path, OpenOrCreate, Write, ReadWrite); - #end - return @:privateAccess new FileOutput(stream); - } - - public static function copy(srcPath:String, dstPath:String):Void { - cs.system.io.File.Copy(srcPath, dstPath, true); - } -} diff --git a/std/cs/_std/sys/io/FileInput.hx b/std/cs/_std/sys/io/FileInput.hx deleted file mode 100644 index 5c67f3e1f1e..00000000000 --- a/std/cs/_std/sys/io/FileInput.hx +++ /dev/null @@ -1,29 +0,0 @@ -/* - * 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 sys.io; - -class FileInput extends cs.io.NativeInput { - function new(stream:cs.system.io.FileStream) { - super(stream); - } -} diff --git a/std/cs/_std/sys/io/FileOutput.hx b/std/cs/_std/sys/io/FileOutput.hx deleted file mode 100644 index fdffd51e44a..00000000000 --- a/std/cs/_std/sys/io/FileOutput.hx +++ /dev/null @@ -1,29 +0,0 @@ -/* - * 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 sys.io; - -class FileOutput extends cs.io.NativeOutput { - function new(stream:cs.system.io.FileStream) { - super(stream); - } -} diff --git a/std/cs/_std/sys/io/Process.hx b/std/cs/_std/sys/io/Process.hx deleted file mode 100644 index 63e473e3e5a..00000000000 --- a/std/cs/_std/sys/io/Process.hx +++ /dev/null @@ -1,127 +0,0 @@ -/* - * 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 sys.io; - -import haxe.io.BytesInput; -import cs.system.io.StreamReader; -import cs.system.io.StreamWriter; -import cs.system.diagnostics.Process as NativeProcess; -import cs.system.diagnostics.ProcessStartInfo as NativeStartInfo; - -@:coreApi -class Process { - public var stdout(default, null):haxe.io.Input; - public var stderr(default, null):haxe.io.Input; - public var stdin(default, null):haxe.io.Output; - - private var native:NativeProcess; - - public function new(cmd:String, ?args:Array, ?detached:Bool):Void { - if (detached) - throw "Detached process is not supported on this platform"; - this.native = createNativeProcess(cmd, args); - native.Start(); - - this.stdout = new cs.io.NativeInput(native.StandardOutput.BaseStream); - this.stderr = new cs.io.NativeInput(native.StandardError.BaseStream); - this.stdin = new cs.io.NativeOutput(native.StandardInput.BaseStream); - } - - @:allow(Sys) - private static function createNativeProcess(cmd:String, ?args:Array):NativeProcess { - var native = new NativeProcess(); - native.StartInfo.CreateNoWindow = true; - native.StartInfo.RedirectStandardError = native.StartInfo.RedirectStandardInput = native.StartInfo.RedirectStandardOutput = true; - if (args != null) { - // mono 4.2.1 on Windows doesn't support relative path correctly - if (cmd.indexOf("/") != -1 || cmd.indexOf("\\") != -1) - cmd = sys.FileSystem.fullPath(cmd); - native.StartInfo.FileName = cmd; - native.StartInfo.UseShellExecute = false; - native.StartInfo.Arguments = buildArgumentsString(args); - } else { - switch (Sys.systemName()) { - case "Windows": - native.StartInfo.FileName = switch (Sys.getEnv("COMSPEC")) { - case null: "cmd.exe"; - case var comspec: comspec; - } - native.StartInfo.Arguments = '/C "$cmd"'; - case _: - native.StartInfo.FileName = "/bin/sh"; - native.StartInfo.Arguments = buildArgumentsString(["-c", cmd]); - } - native.StartInfo.UseShellExecute = false; - } - return native; - } - - private static function buildArgumentsString(args:Array):String { - return switch (Sys.systemName()) { - case "Windows": - [ - for (a in args) - haxe.SysTools.quoteWinArg(a, false) - ].join(" "); - case _: - // mono uses a slightly different quoting/escaping rule... - // https://bugzilla.xamarin.com/show_bug.cgi?id=19296 - [ - for (arg in args) { - var b = new StringBuf(); - b.add('"'); - for (i in 0...arg.length) { - var c = arg.charCodeAt(i); - switch (c) { - case '"'.code | '\\'.code: - b.addChar('\\'.code); - case _: // pass - } - b.addChar(c); - } - b.add('"'); - b.toString(); - } - ].join(" "); - } - } - - public function getPid():Int { - return native.Id; - } - - public function exitCode(block:Bool = true):Null { - if (block == false && !native.HasExited) - return null; - native.WaitForExit(); - return native.ExitCode; - } - - public function close():Void { - native.Close(); - } - - public function kill():Void { - native.Kill(); - } -} diff --git a/std/cs/_std/sys/net/Host.hx b/std/cs/_std/sys/net/Host.hx deleted file mode 100644 index 033db22a7e7..00000000000 --- a/std/cs/_std/sys/net/Host.hx +++ /dev/null @@ -1,75 +0,0 @@ -/* - * 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 sys.net; - -import cs.system.Array; -import cs.system.net.Dns; -import cs.system.net.IPAddress; -import cs.system.net.IPHostEntry; -import cs.system.net.sockets.AddressFamily; -import haxe.io.Bytes; -import haxe.io.BytesInput; - -@:coreapi -class Host { - public var hostEntry(default, null):IPHostEntry; - public var ipAddress(default, null):IPAddress; - - public var host(default, null):String; - - public var ip(get, null):Int; - - private function get_ip():Int { - return new BytesInput(Bytes.ofData(ipAddress.GetAddressBytes())).readInt32(); - } - - public function new(name:String):Void { - host = name; - try{ - hostEntry = Dns.GetHostEntry(host); - for (i in 0...hostEntry.AddressList.Length) { - if (hostEntry.AddressList[i].AddressFamily == InterNetwork) { - ipAddress = hostEntry.AddressList[i]; - break; - } - } - }catch (e:Dynamic){ - ipAddress = IPAddress.Any; - if (!IPAddress.TryParse(host, ipAddress)){ - throw "Unknown host."; - } - } - } - - public function toString():String { - return ipAddress.ToString(); - } - - public function reverse():String { - return hostEntry.HostName; - } - - static public function localhost():String { - return Dns.GetHostName(); - } -} diff --git a/std/cs/_std/sys/net/Socket.hx b/std/cs/_std/sys/net/Socket.hx deleted file mode 100644 index a696fef1947..00000000000 --- a/std/cs/_std/sys/net/Socket.hx +++ /dev/null @@ -1,190 +0,0 @@ -/* - * 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 sys.net; - -import cs.NativeArray; -import cs.system.collections.ArrayList; -import cs.system.net.IPEndPoint; -import cs.system.net.sockets.AddressFamily; -import cs.system.net.sockets.NetworkStream; -import cs.system.net.sockets.ProtocolType; -import cs.system.net.sockets.SocketFlags; -import cs.system.net.sockets.SocketShutdown; -import cs.system.net.sockets.SocketType; -import cs.system.threading.Thread; -import cs.system.net.sockets.Socket in NativeSocket; -import cs.types.UInt8; -import haxe.io.Bytes; -import haxe.io.Error; -import haxe.io.Input; -import haxe.io.Output; - -@:coreApi -class Socket { - private var sock:NativeSocket = null; - - public var input(default, null):haxe.io.Input; - - public var output(default, null):haxe.io.Output; - - public var custom:Dynamic; - - /** - Creates a new unconnected socket. - **/ - public function new():Void { - init(); - } - - private function init():Void { - sock = new NativeSocket(AddressFamily.InterNetwork, SocketType.Stream, ProtocolType.Tcp); - sock.Blocking = true; - } - - public function close():Void { - sock.Close(); - input = null; - output = null; - } - - public function read():String { - return input.readAll().toString(); - } - - public function write(content:String):Void { - output.writeString(content); - } - - public function connect(host:Host, port:Int):Void { - sock.Connect(host.ipAddress, port); - if (sock.Connected) { - this.output = new cs.io.NativeOutput(new NetworkStream(sock)); - this.input = new cs.io.NativeInput(new NetworkStream(sock)); - } else { - throw "Connection failed."; - } - } - - public function listen(connections:Int):Void { - sock.Listen(connections); - } - - public function shutdown(read:Bool, write:Bool):Void { - if (read && write) { - sock.Shutdown(SocketShutdown.Both); - input = null; - output = null; - } else if (read) { - sock.Shutdown(SocketShutdown.Receive); - input = null; - } else if (write) { - sock.Shutdown(SocketShutdown.Send); - output = null; - } - } - - public function bind(host:Host, port:Int):Void { - sock = new NativeSocket(AddressFamily.InterNetwork, SocketType.Stream, ProtocolType.Tcp); - sock.Bind(new IPEndPoint(host.ipAddress, port)); - } - - public function accept():Socket { - var r = new Socket(); - r.sock = sock.Accept(); - r.output = new cs.io.NativeOutput(new NetworkStream(r.sock)); - r.input = new cs.io.NativeInput(new NetworkStream(r.sock)); - return r; - } - - public function peer():{host:Host, port:Int} { - var remoteIP = cast(sock.RemoteEndPoint, IPEndPoint); - return {host: new Host(remoteIP.Address.ToString()), port: remoteIP.Port}; - } - - public function host():{host:Host, port:Int} { - var localIP = cast(sock.LocalEndPoint, IPEndPoint); - return {host: new Host(localIP.Address.ToString()), port: localIP.Port}; - } - - public function setTimeout(timeout:Float):Void { - sock.ReceiveTimeout = sock.SendTimeout = Math.round(timeout * 1000); - } - - public function waitForRead():Void { - var end = Date.now().getTime() + ((sock.ReceiveTimeout <= 0) ? Math.POSITIVE_INFINITY : sock.ReceiveTimeout); - while (sock.Available == 0 && Date.now().getTime() < end) { - Thread.Sleep(5); - } - } - - public function setBlocking(b:Bool):Void { - sock.Blocking = b; - } - - public function setFastSend(b:Bool):Void { - sock.NoDelay = b; - } - - static public function select(read:Array, write:Array, others:Array, - ?timeout:Float):{read:Array, write:Array, others:Array} { - var map:Map = new Map(); - inline function addSockets(sockets:Array) { - if (sockets != null) - for (s in sockets) - map[s.sock.Handle.ToInt32()] = s; - } - inline function getRaw(sockets:Array):ArrayList { - var a = new ArrayList(sockets == null ? 0 : sockets.length); - if (sockets != null) - for (s in sockets) { - a.Add(s.sock); - } - return a; - } - inline function getOriginal(result:ArrayList) { - var a:Array = []; - for (i in 0...result.Count) { - var s:NativeSocket = result[i]; - a.push(map[s.Handle.ToInt32()]); - } - return a; - } - - addSockets(read); - addSockets(write); - addSockets(others); - - // unwrap Sockets into native sockets - var rawRead:ArrayList = getRaw(read), - rawWrite:ArrayList = getRaw(write), - rawOthers:ArrayList = getRaw(others); - var microsec = timeout == null ? -1 : Std.int(timeout * 1000000); - NativeSocket.Select(rawRead, rawWrite, rawOthers, microsec); - // convert native sockets back to Socket objects - return { - read: getOriginal(rawRead), - write: getOriginal(rawWrite), - others: getOriginal(rawOthers), - } - } -} diff --git a/std/cs/_std/sys/net/UdpSocket.hx b/std/cs/_std/sys/net/UdpSocket.hx deleted file mode 100644 index b853d52a52c..00000000000 --- a/std/cs/_std/sys/net/UdpSocket.hx +++ /dev/null @@ -1,99 +0,0 @@ -/* - * 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 sys.net; - -import haxe.extern.Rest; -import sys.net.Socket; -import cs.NativeArray; -import cs.system.collections.ArrayList; -import cs.system.net.IPEndPoint; -import cs.system.net.EndPoint; -import cs.system.net.IPAddress; -import cs.system.net.sockets.AddressFamily; -import cs.system.net.sockets.NetworkStream; -import cs.system.net.sockets.ProtocolType; -import cs.system.net.sockets.SocketFlags; -import cs.system.net.sockets.SocketShutdown; -import cs.system.net.sockets.SocketType; -import cs.system.threading.Thread; -import cs.system.net.sockets.Socket in NativeSocket; -import cs.types.UInt8; -import cs.Ref; -import haxe.io.Bytes; -import haxe.io.Error; -import haxe.io.Input; -import haxe.io.Output; - -@:coreapi -class UdpSocket extends Socket { - public function new() { - super(); - } - - override private function init():Void { - sock = new NativeSocket(AddressFamily.InterNetwork, SocketType.Dgram, ProtocolType.Udp); - } - - override public function bind(host:Host, port:Int):Void { - sock = new NativeSocket(AddressFamily.InterNetwork, SocketType.Dgram, ProtocolType.Udp); - var endpoint:IPEndPoint = new IPEndPoint(host.ipAddress, port); - sock.Bind(endpoint); - } - - public function sendTo(buf:haxe.io.Bytes, pos:Int, len:Int, addr:Address):Int { - var data = new NativeArray(len); - var indices:NativeArray; - for (i in 0...len) { - indices = NativeArray.make(i); - data.SetValue(cast buf.get(pos + i), indices); - } - var host = addr.getHost(); - var ip:IPAddress = IPAddress.Parse(host.toString()); - var endpoint:IPEndPoint = new IPEndPoint(ip, addr.port); - return this.sock.SendTo(data, endpoint); - } - - public function readFrom(buf:haxe.io.Bytes, pos:Int, len:Int, addr:Address):Int { - var endpoint:EndPoint = cast new IPEndPoint(IPAddress.Any, 0); - var data:NativeArray = new NativeArray(len); - var length:Int = -1; - try { - length = this.sock.ReceiveFrom(data, endpoint); - } catch (e:Dynamic) { - return length; - } - var ipEndpoint:IPEndPoint = cast endpoint; - addr.host = ipEndpoint.Address.Address.high; - addr.port = ipEndpoint.Port; - var i:Int = 0; - for (each in data.iterator()) { - buf.set(pos + i, each); - i += 1; - } - return length; - } - - public function setBroadcast(b:Bool):Void { - sock.EnableBroadcast = b; - } -} diff --git a/std/cs/_std/sys/thread/Condition.hx b/std/cs/_std/sys/thread/Condition.hx deleted file mode 100644 index 52b1f24adac..00000000000 --- a/std/cs/_std/sys/thread/Condition.hx +++ /dev/null @@ -1,37 +0,0 @@ -package sys.thread; - -import cs.system.threading.Monitor; - -@:coreApi -@:access(sys.thread.Mutex) -class Condition { - final object:cs.system.Object; - - public function new():Void { - this.object = new cs.system.Object(); - } - - public function acquire():Void { - Monitor.Enter(object); - } - - public function tryAcquire():Bool { - return Monitor.TryEnter(object); - } - - public function release():Void { - Monitor.Exit(object); - } - - public function wait():Void { - Monitor.Wait(object); - } - - public function signal():Void { - Monitor.Pulse(object); - } - - public function broadcast():Void { - Monitor.PulseAll(object); - } -} diff --git a/std/cs/_std/sys/thread/Deque.hx b/std/cs/_std/sys/thread/Deque.hx deleted file mode 100644 index 09f1b59fd68..00000000000 --- a/std/cs/_std/sys/thread/Deque.hx +++ /dev/null @@ -1,60 +0,0 @@ -/* - * 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 sys.thread; - -import cs.system.threading.ManualResetEvent; -import cs.Lib; - -@:coreApi class Deque { - final storage:Array = []; - final lockObj = {}; - final addEvent = new ManualResetEvent(false); - - public function new():Void {} - - public function add(i:T):Void { - Lib.lock(lockObj, { - storage.push(i); - addEvent.Set(); - }); - } - - public function push(i:T):Void { - Lib.lock(lockObj, { - storage.unshift(i); - addEvent.Set(); - }); - } - - public function pop(block:Bool):Null { - do { - Lib.lock(lockObj, { - if (storage.length > 0) { - return storage.shift(); - } - addEvent.Reset(); - }); - } while (block && addEvent.WaitOne()); - return null; - } -} diff --git a/std/cs/_std/sys/thread/Lock.hx b/std/cs/_std/sys/thread/Lock.hx deleted file mode 100644 index e7c79d7f9e4..00000000000 --- a/std/cs/_std/sys/thread/Lock.hx +++ /dev/null @@ -1,79 +0,0 @@ -/* - * 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 sys.thread; - -import haxe.Timer; -import cs.Lib; -import cs.system.threading.ManualResetEvent; - -class Lock { - final lockObj = {}; - final releaseEvent = new ManualResetEvent(false); - - var waitCount = 1; // initially locked - var releaseCount = 0; - - public function new():Void {} - - public function wait(?timeout:Float):Bool { - var myTicket; - // Get a ticket in queue - Lib.lock(lockObj, { - myTicket = waitCount; - waitCount++; - if (myTicket <= releaseCount) { - return true; - } - releaseEvent.Reset(); - }); - - if (timeout == null) { - do { - releaseEvent.WaitOne(); - if (myTicket <= releaseCount) { - return true; - } - } while (true); - } else { - var timeoutStamp = Timer.stamp() + timeout; - do { - var secondsLeft = timeoutStamp - Timer.stamp(); - if (secondsLeft <= 0 || !releaseEvent.WaitOne(Std.int(secondsLeft * 1000))) { - // Timeout. Do not occupy a place in queue anymore - release(); - return false; - } - if (myTicket <= releaseCount) { - return true; - } - } while (true); - } - } - - public function release():Void { - Lib.lock(lockObj, { - releaseCount++; - releaseEvent.Set(); - }); - } -} diff --git a/std/cs/_std/sys/thread/Mutex.hx b/std/cs/_std/sys/thread/Mutex.hx deleted file mode 100644 index 184f9d837e5..00000000000 --- a/std/cs/_std/sys/thread/Mutex.hx +++ /dev/null @@ -1,43 +0,0 @@ -/* - * 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 sys.thread; - -import cs.system.threading.Mutex as NativeMutex; - -class Mutex { - final native = new NativeMutex(); - - public function new():Void {} - - public function acquire():Void { - native.WaitOne(); - } - - public function tryAcquire():Bool { - return native.WaitOne(0); - } - - public function release():Void { - native.ReleaseMutex(); - } -} diff --git a/std/cs/_std/sys/thread/Semaphore.hx b/std/cs/_std/sys/thread/Semaphore.hx deleted file mode 100644 index e08064b8a0d..00000000000 --- a/std/cs/_std/sys/thread/Semaphore.hx +++ /dev/null @@ -1,22 +0,0 @@ -package sys.thread; - -@:coreApi -class Semaphore { - final native:cs.system.threading.Semaphore; - - public function new(value:Int):Void { - this.native = new cs.system.threading.Semaphore(value, 0x7FFFFFFF); - } - - public function acquire():Void { - native.WaitOne(); - } - - public function tryAcquire(?timeout:Float):Bool { - return native.WaitOne(timeout == null ? 0 : Std.int(timeout * 1000)); - } - - public function release():Void { - native.Release(); - } -} diff --git a/std/cs/_std/sys/thread/Thread.hx b/std/cs/_std/sys/thread/Thread.hx deleted file mode 100644 index ba26e7ba9ef..00000000000 --- a/std/cs/_std/sys/thread/Thread.hx +++ /dev/null @@ -1,184 +0,0 @@ -/* - * 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 sys.thread; - -import cs.system.threading.Thread as NativeThread; -import cs.system.threading.Mutex as NativeMutex; -import cs.system.WeakReference; -import cs.Lib; - -private typedef ThreadImpl = HaxeThread; - -abstract Thread(ThreadImpl) from ThreadImpl { - public var events(get,never):EventLoop; - - inline function new(thread:HaxeThread) { - this = thread; - } - - public static function create(job:Void->Void):Thread { - var hx:Null = null; - var native = new NativeThread(job); - native.IsBackground = true; - hx = HaxeThread.allocate(native, false); - native.Start(); - - return new Thread(hx); - } - - public static inline function runWithEventLoop(job:()->Void):Void { - HaxeThread.runWithEventLoop(job); - } - - public static inline function createWithEventLoop(job:()->Void):Thread { - var hx:Null = null; - var native = new NativeThread(() -> { - job(); - if(hx == null) { - HaxeThread.get(NativeThread.CurrentThread).events.loop(); - } else { - hx.events.loop(); - } - }); - native.IsBackground = true; - hx = HaxeThread.allocate(native, true); - native.Start(); - - return new Thread(hx); - } - - public static inline function current():Thread { - return new Thread(HaxeThread.get(NativeThread.CurrentThread)); - } - - public static function readMessage(block:Bool):Dynamic { - return current().readMessageImpl(block); - } - - public inline function sendMessage(msg:Dynamic):Void { - this.sendMessage(msg); - } - - inline function readMessageImpl(block:Bool):Dynamic { - return this.readMessage(block); - } - - function get_events():EventLoop { - if(this.events == null) - throw new NoEventLoopException(); - return this.events; - } - - @:keep - static function processEvents():Void { - HaxeThread.get(NativeThread.CurrentThread).events.loop(); - } -} - -private class HaxeThread { - static var mainNativeThread:NativeThread; - static var mainHaxeThread:HaxeThread; - static var threads:Map; - static var threadsMutex:NativeMutex; - static var allocateCount:Int; - - static function __init__() { - threads = new Map(); - threadsMutex = new NativeMutex(); - allocateCount = 0; - mainNativeThread = NativeThread.CurrentThread; - mainHaxeThread = new HaxeThread(NativeThread.CurrentThread); - mainHaxeThread.events = new EventLoop(); - } - - public final native:NativeThread; - public var events(default,null):Null; - - final messages = new Deque(); - - public static function get(native:NativeThread):HaxeThread { - if(native == mainNativeThread) { - return mainHaxeThread; - } - var native = NativeThread.CurrentThread; - var key = native.ManagedThreadId; - threadsMutex.WaitOne(); - var ref = threads.get(key); - threadsMutex.ReleaseMutex(); - if (ref == null || !ref.IsAlive) { - return allocate(native, false); - } - return ref.Target; - } - - public static function allocate(native:NativeThread, withEventLoop:Bool):HaxeThread { - threadsMutex.WaitOne(); - allocateCount++; - inline function cleanup() { - if (allocateCount % 100 == 0) { - for (key => ref in threads) { - if (!ref.IsAlive) { - threads.remove(key); - } - } - } - } - var hx = new HaxeThread(native); - if(withEventLoop) - hx.events = new EventLoop(); - var ref = new WeakReference(hx); - cleanup(); - threads.set(native.ManagedThreadId, ref); - threadsMutex.ReleaseMutex(); - return hx; - } - - public static function runWithEventLoop(job:()->Void):Void { - var thread = get(NativeThread.CurrentThread); - if(thread.events == null) { - thread.events = new EventLoop(); - try { - job(); - thread.events.loop(); - thread.events = null; - } catch(e) { - thread.events = null; - throw e; - } - } else { - job(); - } - } - - function new(native:NativeThread) { - this.native = native; - } - - public inline function readMessage(block:Bool):Dynamic { - return messages.pop(block); - } - - public function sendMessage(msg:Dynamic):Void { - messages.add(msg); - } -} diff --git a/std/cs/_std/sys/thread/Tls.hx b/std/cs/_std/sys/thread/Tls.hx deleted file mode 100644 index 13c77a1bd29..00000000000 --- a/std/cs/_std/sys/thread/Tls.hx +++ /dev/null @@ -1,45 +0,0 @@ -/* - * 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 sys.thread; - -import cs.system.threading.Thread as NativeThread; -import cs.system.LocalDataStoreSlot; - -class Tls { - public var value(get, set):T; - - final slot:LocalDataStoreSlot; - - public function new():Void { - slot = NativeThread.GetNamedDataSlot('__hx__Tls'); - } - - function get_value():T { - return NativeThread.GetData(slot); - } - - function set_value(value:T):T { - NativeThread.SetData(slot, value); - return value; - } -} diff --git a/std/cs/internal/BoxedPointer.hx b/std/cs/internal/BoxedPointer.hx deleted file mode 100644 index 2b94161ff0b..00000000000 --- a/std/cs/internal/BoxedPointer.hx +++ /dev/null @@ -1,31 +0,0 @@ -/* - * 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 cs.internal; - -@:unsafe @:keep @:native('haxe.lang.BoxedPointer') @:nativeGen class BoxedPointer { - @:readonly public var value(default, null):Pointer; - - public function new(val) { - this.value = val; - } -} diff --git a/std/cs/internal/FieldLookup.hx b/std/cs/internal/FieldLookup.hx deleted file mode 100644 index 59739d8f391..00000000000 --- a/std/cs/internal/FieldLookup.hx +++ /dev/null @@ -1,311 +0,0 @@ -/* - * 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 cs.internal; - -@:native('haxe.lang.FieldHashConflict') -@:nativeGen @:keep -final class FieldHashConflict { - @:readOnly public var hash(default, never):Int; - @:readOnly public var name(default, never):String; - public var value:Dynamic; - public var next:FieldHashConflict; - - public function new(hash, name, value:Dynamic, next) { - untyped this.hash = hash; - untyped this.name = name; - this.value = value; - this.next = next; - } -} - -@:native('haxe.lang.FieldLookup') -@:classCode("#pragma warning disable 628\n") -@:nativeGen @:keep @:static -final class FieldLookup { - @:protected private static var fieldIds:cs.NativeArray; - @:protected private static var fields:cs.NativeArray; - @:protected private static var length:Int; - - static function __init__() { - length = fieldIds.Length; - } - - private static function addFields(nids:cs.NativeArray, nfields:cs.NativeArray):Void { - // first see if we need to add anything - var cids = fieldIds, cfields = fields; - var nlen = nids.Length; - var clen = length; - if (nfields.Length != nlen) - throw 'Different fields length: $nlen and ${nfields.Length}'; - - // TODO optimize - var needsChange = false; - for (i in nids) { - if (findHash(i, cids, clen) < 0) { - needsChange = true; - break; - } - } - - // if we do, lock and merge - if (needsChange) { - cs.Lib.lock(FieldLookup, { - // trace(cs.Lib.array(nids), cs.Lib.array(cids)); - var ansIds = new cs.NativeArray(clen + nlen), - ansFields = new cs.NativeArray(clen + nlen); - var ci = 0, ni = 0, ansi = 0; - while (ci < clen && ni < nlen) { - if (cids[ci] < nids[ni]) { - ansIds[ansi] = cids[ci]; - ansFields[ansi] = cfields[ci]; - ++ci; - } else { - ansIds[ansi] = nids[ni]; - ansFields[ansi] = nfields[ni]; - ++ni; - } - ++ansi; - } - - if (ci < clen) { - cs.system.Array.Copy(cids, ci, ansIds, ansi, clen - ci); - cs.system.Array.Copy(cfields, ci, ansFields, ansi, clen - ci); - ansi += clen - ci; - } - - if (ni < nlen) { - cs.system.Array.Copy(nids, ni, ansIds, ansi, nlen - ni); - cs.system.Array.Copy(nfields, ni, ansFields, ansi, nlen - ni); - ansi += nlen - ni; - } - - // trace(cs.Lib.array(ansIds)); - fieldIds = ansIds; - fields = ansFields; - length = ansi; - }); - } - } - - // s cannot be null here - private static inline function doHash(s:String):Int { - var acc = 0; // alloc_int - for (i in 0...s.length) { - acc = ((223 * (acc >> 1) + cast(s[i], Int)) << 1); - } - - return acc >>> 1; // always positive - } - - public static function lookupHash(key:Int):String { - var ids = fieldIds; - var min = 0; - var max = length; - - while (min < max) { - var mid = min + Std.int((max - min) / 2); - var imid = ids[mid]; - if (key < imid) { - max = mid; - } else if (key > imid) { - min = mid + 1; - } else { - return fields[mid]; - } - } - // if not found, it's definitely an error - throw "Field not found for hash " + key; - } - - public static function hash(s:String):Int { - if (s == null) - return 0; - - var key = doHash(s); - - var ids = fieldIds, fld = fields; - var min = 0; - var max = length; - - var len = length; - - while (min < max) { - var mid = Std.int(min + (max - min) / 2); // overflow safe - var imid = ids[mid]; - if (key < imid) { - max = mid; - } else if (key > imid) { - min = mid + 1; - } else { - var field = fld[mid]; - if (field != s) - return ~key; // special case - return key; - } - } - - // if not found, min holds the value where we should insert the key - // ensure thread safety: - cs.Lib.lock(FieldLookup, { - if (len != length) // race condition which will very rarely happen - other thread modified sooner. - return hash(s); // since we already own the lock, this second try will always succeed - - fieldIds = insertInt(fieldIds, length, min, key); - fields = insertString(fields, length, min, s); - ++length; - }); - return key; - } - - public static function findHash(hash:Int, hashs:cs.NativeArray, length:Int):Int { - var min = 0; - var max = length; - - while (min < max) { - var mid = Std.int((max + min) / 2); - var imid = hashs[mid]; - if (hash < imid) { - max = mid; - } else if (hash > imid) { - min = mid + 1; - } else { - return mid; - } - } - // if not found, return a negative value of where it should be inserted - return ~min; - } - - public static function removeInt(a:cs.NativeArray, length:Int, pos:Int) { - cs.system.Array.Copy(a, pos + 1, a, pos, length - pos - 1); - a[length - 1] = 0; - } - - public static function removeFloat(a:cs.NativeArray, length:Int, pos:Int) { - cs.system.Array.Copy(a, pos + 1, a, pos, length - pos - 1); - a[length - 1] = 0; - } - - public static function removeDynamic(a:cs.NativeArray, length:Int, pos:Int) { - cs.system.Array.Copy(a, pos + 1, a, pos, length - pos - 1); - a[length - 1] = null; - } - - extern static inline function __insert(a:cs.NativeArray, length:Int, pos:Int, x:T):cs.NativeArray { - var capacity = a.Length; - if (pos == length) { - if (capacity == length) { - var newarr = new NativeArray((length << 1) + 1); - a.CopyTo(newarr, 0); - a = newarr; - } - } else if (pos == 0) { - if (capacity == length) { - var newarr = new NativeArray((length << 1) + 1); - cs.system.Array.Copy(a, 0, newarr, 1, length); - a = newarr; - } else { - cs.system.Array.Copy(a, 0, a, 1, length); - } - } else { - if (capacity == length) { - var newarr = new NativeArray((length << 1) + 1); - cs.system.Array.Copy(a, 0, newarr, 0, pos); - cs.system.Array.Copy(a, pos, newarr, pos + 1, length - pos); - a = newarr; - } else { - cs.system.Array.Copy(a, pos, a, pos + 1, length - pos); - cs.system.Array.Copy(a, 0, a, 0, pos); - } - } - a[pos] = x; - return a; - } - - public static function insertInt(a:cs.NativeArray, length:Int, pos:Int, x:Int):cs.NativeArray - return __insert(a, length, pos, x); - - public static function insertFloat(a:cs.NativeArray, length:Int, pos:Int, x:Float):cs.NativeArray - return __insert(a, length, pos, x); - - public static function insertDynamic(a:cs.NativeArray, length:Int, pos:Int, x:Dynamic):cs.NativeArray - return __insert(a, length, pos, x); - - public static function insertString(a:cs.NativeArray, length:Int, pos:Int, x:String):cs.NativeArray - return __insert(a, length, pos, x); - - public static function getHashConflict(head:FieldHashConflict, hash:Int, name:String):FieldHashConflict { - while (head != null) { - if (head.hash == hash && head.name == name) { - return head; - } - head = head.next; - } - return null; - } - - public static function setHashConflict(head:cs.Ref, hash:Int, name:String, value:Dynamic):Void { - var node = head; - while (node != null) { - if (node.hash == hash && node.name == name) { - node.value = value; - return; - } - node = node.next; - } - head = new FieldHashConflict(hash, name, value, head); - } - - public static function deleteHashConflict(head:cs.Ref, hash:Int, name:String):Bool { - // no conflicting fields at all - if (head == null) { - return false; - } - - // list head is conflicting - just point it to the next one - if (head.hash == hash && head.name == name) { - head = head.next; - return true; - } - - // loop through the list, removing node if there's one - var prev = head, node = head.next; - while (node != null) { - if (node.hash == hash && node.name == name) { - prev.next = node.next; - return true; - } - node = node.next; - } - - // not found - return false; - } - - public static function addHashConflictNames(head:FieldHashConflict, arr:Array):Void { - while (head != null) { - arr.push(head.name); - head = head.next; - } - } -} diff --git a/std/cs/internal/Function.hx b/std/cs/internal/Function.hx deleted file mode 100644 index e756406f268..00000000000 --- a/std/cs/internal/Function.hx +++ /dev/null @@ -1,79 +0,0 @@ -/* - * 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 cs.internal; - -/** - These classes are automatically generated by the compiler. They are only - here so there is an option for e.g. defining them as externs if you are compiling - in modules (untested). -**/ -@:keep @:abstract @:nativeGen @:native("haxe.lang.Function") class Function { - function new(arity:Int, type:Int) {} -} - -@:keep @:nativeGen @:native("haxe.lang.VarArgsBase") private class VarArgsBase extends Function { - public function __hx_invokeDynamic(dynArgs:cs.NativeArray):Dynamic { - throw "Abstract implementation"; - } -} - -@:keep @:nativeGen @:native('haxe.lang.VarArgsFunction') class VarArgsFunction extends VarArgsBase { - private var fun:Array->Dynamic; - - public function new(fun) { - super(-1, -1); - this.fun = fun; - } - - override public function __hx_invokeDynamic(dynArgs:cs.NativeArray):Dynamic { - return fun(dynArgs == null ? [] : cs.Lib.array(dynArgs)); - } -} - -@:keep @:nativeGen @:native('haxe.lang.Closure') class Closure extends VarArgsBase { - private var obj:Dynamic; - private var field:String; - private var hash:Int; - - public function new(obj:Dynamic, field, hash) { - super(-1, -1); - this.obj = obj; - this.field = field; - this.hash = hash; - } - - override public function __hx_invokeDynamic(dynArgs:cs.NativeArray):Dynamic { - return Runtime.callField(obj, field, hash, dynArgs); - } - - public function Equals(obj:Dynamic):Bool { - var c = cs.Lib.as(obj, Closure); - if (c == null) - return false; - return (c.obj == this.obj && c.field == this.field); - } - - public function GetHashCode():Int { - return obj.GetHashCode() ^ untyped field.GetHashCode(); - } -} diff --git a/std/cs/internal/HxObject.hx b/std/cs/internal/HxObject.hx deleted file mode 100644 index 5dbf5e3cfd2..00000000000 --- a/std/cs/internal/HxObject.hx +++ /dev/null @@ -1,317 +0,0 @@ -/* - * 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 cs.internal; - -import cs.system.Type; -import haxe.ds.Vector; -import cs.internal.FieldLookup; - -private typedef StdType = std.Type; - -@:keep @:native('haxe.lang.HxObject') -class HxObject implements IHxObject { - public function __hx_deleteField(field:String, hash:Int):Bool { - return false; - } -} - -@:keep @:native('haxe.lang.IHxObject') -interface IHxObject {} - -#if core_api_serialize -@:meta(System.Serializable) -#end -@:keep @:native('haxe.lang.DynamicObject') -class DynamicObject extends HxObject { - @:skipReflection var __hx_hashes:NativeArray; - @:skipReflection var __hx_dynamics:NativeArray; - - @:skipReflection var __hx_hashes_f:NativeArray; - @:skipReflection var __hx_dynamics_f:NativeArray; - - @:skipReflection var __hx_length:Int; - @:skipReflection var __hx_length_f:Int; - @:skipReflection var __hx_conflicts:FieldHashConflict; - - @:skipReflection static var __hx_toString_depth = 0; - - @:overload public function new() { - this.__hx_hashes = new NativeArray(0); - this.__hx_dynamics = new NativeArray(0); - this.__hx_hashes_f = new NativeArray(0); - this.__hx_dynamics_f = new NativeArray(0); - this.__hx_conflicts = null; - } - - @:overload public function new(hashes:NativeArray, dynamics:NativeArray, hashes_f:NativeArray, dynamics_f:NativeArray) { - this.__hx_hashes = hashes; - this.__hx_dynamics = dynamics; - this.__hx_hashes_f = hashes_f; - this.__hx_dynamics_f = dynamics_f; - this.__hx_length = hashes.length; - this.__hx_length_f = hashes_f.length; - this.__hx_conflicts = null; - } - - override public function __hx_deleteField(field:String, hash:Int):Bool { - if (hash < 0) { - return FieldLookup.deleteHashConflict(this.__hx_conflicts, hash, field); - } - - var res = FieldLookup.findHash(hash, this.__hx_hashes, this.__hx_length); - if (res >= 0) { - FieldLookup.removeInt(this.__hx_hashes, this.__hx_length, res); - FieldLookup.removeDynamic(this.__hx_dynamics, this.__hx_length, res); - this.__hx_length--; - return true; - } - res = FieldLookup.findHash(hash, this.__hx_hashes_f, this.__hx_length_f); - if (res >= 0) { - FieldLookup.removeInt(this.__hx_hashes_f, this.__hx_length_f, res); - FieldLookup.removeFloat(this.__hx_dynamics_f, this.__hx_length_f, res); - this.__hx_length_f--; - return true; - } - return false; - } - - public function __hx_getField(field:String, hash:Int, throwErrors:Bool, isCheck:Bool, handleProperties:Bool):Dynamic { - if (hash < 0) { - var conflict = FieldLookup.getHashConflict(this.__hx_conflicts, hash, field); - if (conflict != null) { - return conflict.value; - } - } - - var res = FieldLookup.findHash(hash, this.__hx_hashes, this.__hx_length); - if (res >= 0) { - return this.__hx_dynamics[res]; - } - res = FieldLookup.findHash(hash, this.__hx_hashes_f, this.__hx_length_f); - if (res >= 0) { - return this.__hx_dynamics_f[res]; - } - - return isCheck ? Runtime.undefined : null; - } - - public function __hx_setField(field:String, hash:Int, value:Dynamic, handleProperties:Bool):Dynamic { - if (hash < 0) { - FieldLookup.setHashConflict(this.__hx_conflicts, hash, field, value); - return value; - } - - var res = FieldLookup.findHash(hash, this.__hx_hashes, this.__hx_length); - if (res >= 0) { - return this.__hx_dynamics[res] = value; - } else { - var res = FieldLookup.findHash(hash, this.__hx_hashes_f, this.__hx_length_f); - if (res >= 0) { - if (Std.isOfType(value, Float)) { - return this.__hx_dynamics_f[res] = value; - } - - FieldLookup.removeInt(this.__hx_hashes_f, this.__hx_length_f, res); - FieldLookup.removeFloat(this.__hx_dynamics_f, this.__hx_length_f, res); - this.__hx_length_f--; - } - } - - this.__hx_hashes = FieldLookup.insertInt(this.__hx_hashes, this.__hx_length, ~(res), hash); - this.__hx_dynamics = FieldLookup.insertDynamic(this.__hx_dynamics, this.__hx_length, ~(res), value); - this.__hx_length++; - return value; - } - - public function __hx_getField_f(field:String, hash:Int, throwErrors:Bool, handleProperties:Bool):Float { - if (hash < 0) { - var conflict = FieldLookup.getHashConflict(this.__hx_conflicts, hash, field); - if (conflict != null) { - return conflict.value; - } - } - - var res = FieldLookup.findHash(hash, this.__hx_hashes_f, this.__hx_length_f); - if (res >= 0) { - return this.__hx_dynamics_f[res]; - } - res = FieldLookup.findHash(hash, this.__hx_hashes, this.__hx_length); - if (res >= 0) { - return this.__hx_dynamics[res]; - } - - return 0.0; - } - - public function __hx_setField_f(field:String, hash:Int, value:Float, handleProperties:Bool):Float { - if (hash < 0) { - FieldLookup.setHashConflict(this.__hx_conflicts, hash, field, value); - return value; - } - - var res = FieldLookup.findHash(hash, this.__hx_hashes_f, this.__hx_length_f); - if (res >= 0) { - return this.__hx_dynamics_f[res] = value; - } else { - var res = FieldLookup.findHash(hash, this.__hx_hashes, this.__hx_length); - if (res >= 0) { - // return this.__hx_dynamics[res] = value; - FieldLookup.removeInt(this.__hx_hashes, this.__hx_length, res); - FieldLookup.removeDynamic(this.__hx_dynamics, this.__hx_length, res); - this.__hx_length--; - } - } - - this.__hx_hashes_f = FieldLookup.insertInt(this.__hx_hashes_f, this.__hx_length_f, ~(res), hash); - this.__hx_dynamics_f = FieldLookup.insertFloat(this.__hx_dynamics_f, this.__hx_length_f, ~(res), value); - this.__hx_length_f++; - return value; - } - - public function __hx_getFields(baseArr:Array):Void { - for (i in 0...this.__hx_length) { - baseArr.push(FieldLookup.lookupHash(this.__hx_hashes[i])); - } - for (i in 0...this.__hx_length_f) { - baseArr.push(FieldLookup.lookupHash(this.__hx_hashes_f[i])); - } - FieldLookup.addHashConflictNames(this.__hx_conflicts, baseArr); - } - - public function __hx_invokeField(field:String, hash:Int, dynargs:NativeArray):Dynamic { - if (field == "toString") { - return this.toString(); - } - var fn:Function = this.__hx_getField(field, hash, false, false, false); - if (fn == null) { - throw 'Cannot invoke field $field: It does not exist'; - } - - return untyped fn.__hx_invokeDynamic(dynargs); - } - - @:skipReflection public function toString() { - if (__hx_toString_depth >= 5) { - return "..."; - } - ++__hx_toString_depth; - try { - var s = __hx_toString(); - --__hx_toString_depth; - return s; - } catch (e:Dynamic) { - --__hx_toString_depth; - throw(e); - } - } - - @:skipReflection public function __hx_toString():String { - var ts = Reflect.field(this, "toString"); - if (ts != null) - return ts(); - var ret = new StringBuf(); - ret.add("["); - var first = true; - for (f in Reflect.fields(this)) { - if (first) - first = false; - else - ret.add(","); - ret.add(" "); - ret.add(f); - ret.add(" : "); - ret.add(Reflect.field(this, f)); - } - if (!first) - ret.add(" "); - ret.add("]"); - return ret.toString(); - } -} - -#if !erase_generics -@:keep @:native('haxe.lang.IGenericObject') interface IGenericObject {} - -@:nativeGen @:keep @:native('haxe.lang.GenericInterface') class GenericInterface extends cs.system.Attribute { - @:readOnly public var generic(default, never):cs.system.Type; - - public function new(generic) { - super(); - untyped this.generic = generic; - } -} -#end - -@:keep -@:native('haxe.lang.Enum') -@:nativeGen -#if core_api_serialize -@:meta(System.Serializable) -#end -class HxEnum { - @:readOnly var _hx_index(default, never):Int; - - @:protected function new(index:Int) { - untyped this._hx_index = index; - } - - public function getTag():String { - return throw new haxe.exceptions.NotImplementedException(); - } - - public function getParams():Array<{}> { - return []; - } - - public function toString():String { - return getTag(); - } - - @:protected static function paramsToString(tag:String, params:Vector):String { - var ret = new StringBuf(); - ret.add(tag); - ret.add("("); - var first = true; - for (p in params) { - if (first) - first = false; - else - ret.add(","); - ret.add(p); - } - ret.add(")"); - return ret.toString(); - } - - @:protected static function paramsGetHashCode(index:Int, params:Vector):Int { - var h:Int = 19; - if (params != null) - for (p in params) { - h = h * 31; - if (p != null) - untyped h += p.GetHashCode(); - } - h += index; - return h; - } -} diff --git a/std/cs/internal/Null.hx b/std/cs/internal/Null.hx deleted file mode 100644 index 57213d4b49f..00000000000 --- a/std/cs/internal/Null.hx +++ /dev/null @@ -1,88 +0,0 @@ -/* - * 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 cs.internal; - -@:classCode('//This function is here to be used with Reflection, when the haxe.lang.Null type is known - public static haxe.lang.Null _ofDynamic(object obj) { - if (obj == null) { - return new haxe.lang.Null(default(T), false); - } else if (typeof(T).Equals(typeof(double))) { - return new haxe.lang.Null((T) (object) haxe.lang.Runtime.toDouble(obj), true); - } else if (typeof(T).Equals(typeof(int))) { - return new haxe.lang.Null((T) (object) haxe.lang.Runtime.toInt(obj), true); - } else { - return new haxe.lang.Null((T) obj, true); - } - } - - public static implicit operator haxe.lang.Null(T val) { - return new haxe.lang.Null(val, true); - } - - public static implicit operator Null(__NoValue__ noValue) { - return new haxe.lang.Null(default(T), false); - } - - public sealed class __NoValue__ { - private __NoValue__() {} - } - - override public string ToString() { - if (!hasValue) return "null"; - else return value.ToString(); - } -') -#if core_api_serialize -@:meta(System.Serializable) -#end -@:keep @:struct @:nativeGen @:native("haxe.lang.Null") private class Nullable { - @:readOnly public var value(default, never):T; - @:readOnly public var hasValue(default, never):Bool; - - public function new(v:T, hasValue:Bool) { - if (hasValue && cs.system.Object.ReferenceEquals(v, null)) { - hasValue = false; - } - untyped this.value = v; - untyped this.hasValue = hasValue; - } - - @:functionCode('if (obj == null) { - return new haxe.lang.Null(default(D), false); - } else if (typeof(D).Equals(typeof(double))) { - return new haxe.lang.Null((D) (object) haxe.lang.Runtime.toDouble(obj), true); - } else if (typeof(D).Equals(typeof(int))) { - return new haxe.lang.Null((D) (object) haxe.lang.Runtime.toInt(obj), true); - } else { - return new haxe.lang.Null((D) obj, true); - }') - public static function ofDynamic(obj:Dynamic):Nullable { - return null; - } - - public function toDynamic():Dynamic { - if (this.hasValue) - return value; - return null; - } -} diff --git a/std/cs/internal/Runtime.hx b/std/cs/internal/Runtime.hx deleted file mode 100644 index e307d965686..00000000000 --- a/std/cs/internal/Runtime.hx +++ /dev/null @@ -1,712 +0,0 @@ -/* - * 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 cs.internal; - -import cs.Lib; -import cs.Lib.*; -import cs.NativeArray; -import cs.StdTypes; -import cs.system.Activator; -import cs.system.IConvertible; -import cs.system.IComparable; -import cs.system.reflection.MethodBase; -import cs.system.reflection.MethodInfo; -import cs.system.reflection.*; -import cs.system.Type; -import cs.system.Object; - -/** - This class is meant for internal compiler use only. It provides the Haxe runtime - compatibility to the host language. -**/ -@:nativeGen -@:native('haxe.lang.Runtime') -@:access(String) -@:classCode(' - public static object getField(haxe.lang.HxObject obj, string field, int fieldHash, bool throwErrors) - { - if (obj == null && !throwErrors) return null; - return obj.__hx_getField(field, (fieldHash == 0) ? haxe.lang.FieldLookup.hash(field) : fieldHash, throwErrors, false, false); - } - - public static double getField_f(haxe.lang.HxObject obj, string field, int fieldHash, bool throwErrors) - { - if (obj == null && !throwErrors) return 0.0; - return obj.__hx_getField_f(field, (fieldHash == 0) ? haxe.lang.FieldLookup.hash(field) : fieldHash, throwErrors, false); - } - - public static object setField(haxe.lang.HxObject obj, string field, int fieldHash, object value) - { - return obj.__hx_setField(field, (fieldHash == 0) ? haxe.lang.FieldLookup.hash(field) : fieldHash, value, false); - } - - public static double setField_f(haxe.lang.HxObject obj, string field, int fieldHash, double value) - { - return obj.__hx_setField_f(field, (fieldHash == 0) ? haxe.lang.FieldLookup.hash(field) : fieldHash, value, false); - } - - public static object callField(haxe.lang.HxObject obj, string field, int fieldHash, object[] args) - { - return obj.__hx_invokeField(field, (fieldHash == 0) ? haxe.lang.FieldLookup.hash(field) : fieldHash, args); - } -') -@:keep class Runtime { - @:readOnly public static var undefined(default, never):Dynamic = new cs.system.Object(); - - public static function closure(obj:Dynamic, hash:Int, field:String):Dynamic { - return new cs.internal.Function.Closure(obj, field, hash); - } - - public static function eq(v1:Dynamic, v2:Dynamic):Bool { - if (Object.ReferenceEquals(v1, v2)) - return true; - if (Object.ReferenceEquals(v1, null) || Object.ReferenceEquals(v2, null)) - return false; - - var v1c = Lib.as(v1, IConvertible); - if (v1c != null) { - var v2c = Lib.as(v2, IConvertible); - if (v2c == null) { - return false; - } - - var t1 = v1c.GetTypeCode(), t2 = v2c.GetTypeCode(); - if (t1 == t2) - return Object._Equals(v1c, v2c); - - if (t1 == cs.system.TypeCode.String || t2 == cs.system.TypeCode.String) - return false; - - switch [t1, t2] { - case [Decimal, _] | [_, Decimal]: - return v1c.ToDecimal(null) == v2c.ToDecimal(null); - case [Int64, _] | [_, Int64]: - return v1c.ToInt64(null) == v2c.ToInt64(null); - case [UInt64 | DateTime, _] | [_, UInt64 | DateTime]: - return v1c.ToUInt64(null) == v2c.ToUInt64(null); - case [Double | Single, _] | [_, Double | Single]: - return v1c.ToDouble(null) == v2c.ToDouble(null); - case _: - return v1c.ToInt32(null) == v2c.ToInt32(null); - } - } - - var v1v = Lib.as(v1, cs.system.ValueType); - if (v1v != null) { - return v1.Equals(v2); - #if !erase_generics - } - else { - var v1t = Lib.as(v1, Type); - if (v1t != null) { - var v2t = Lib.as(v2, Type); - if (v2t != null) - return typeEq(v1t, v2t); - return false; - } - #end - } - - return false; - } - - public static function refEq(v1:{}, v2:{}):Bool { - #if !erase_generics - if (Std.isOfType(v1, Type)) - return typeEq(Lib.as(v1, Type), Lib.as(v2, Type)); - #end - return Object.ReferenceEquals(v1, v2); - } - - public static function toDouble(obj:Dynamic):Float { - return (obj == null) ? .0 : Std.isOfType(obj, Float) ? cast obj : Lib.as(obj, IConvertible).ToDouble(null); - } - - public static function toInt(obj:Dynamic):Int { - return (obj == null) ? 0 : Std.isOfType(obj, Int) ? cast obj : Lib.as(obj, IConvertible).ToInt32(null); - } - - #if erase_generics - public static function toLong(obj:Dynamic):Int64 { - return (obj == null) ? 0 : Std.isOfType(obj, Int64) ? cast obj : Lib.as(obj, IConvertible).ToInt64(null); - } - #end - - public static function isInt(obj:Dynamic):Bool { - var cv1 = Lib.as(obj, IConvertible); - if (cv1 != null) { - switch (cv1.GetTypeCode()) { - case Double: - var d:Float = cast obj; - return d >= cs.system.Int32.MinValue && d <= cs.system.Int32.MaxValue && d == (cast(d, Int)); - case UInt32, Int32: - return true; - default: - return false; - } - } - return false; - } - - public static function isUInt(obj:Dynamic):Bool { - var cv1 = Lib.as(obj, IConvertible); - if (cv1 != null) { - switch (cv1.GetTypeCode()) { - case Double: - var d:Float = cast obj; - return d >= cs.system.UInt32.MinValue && d <= cs.system.UInt32.MaxValue && d == (cast(d, UInt)); - case UInt32: - return true; - default: - return false; - } - } - return false; - } - - public static function compare(v1:Dynamic, v2:Dynamic):Int { - if (Object.ReferenceEquals(v1, v2)) - return 0; - if (Object.ReferenceEquals(v1, null)) - return -1; - if (Object.ReferenceEquals(v2, null)) - return 1; - - var cv1 = Lib.as(v1, IConvertible); - if (cv1 != null) { - var cv2 = Lib.as(v2, IConvertible); - - if (cv2 == null) { - throw new cs.system.ArgumentException("Cannot compare " + getNativeType(v1).ToString() + " and " + getNativeType(v2).ToString()); - } - - switch (cv1.GetTypeCode()) { - case cs.system.TypeCode.String: - if (cv2.GetTypeCode() != cs.system.TypeCode.String) - throw new cs.system.ArgumentException("Cannot compare " + getNativeType(v1).ToString() + " and " + getNativeType(v2).ToString()); - var s1 = Lib.as(v1, String); - var s2 = Lib.as(v2, String); - return String.Compare(s1, s2, cs.system.StringComparison.Ordinal); - case cs.system.TypeCode.Double: - var d1:Float = cast v1, d2:Float = cv2.ToDouble(null); - return (d1 < d2) ? -1 : (d1 > d2) ? 1 : 0; - default: - var d1d = cv1.ToDouble(null); - var d2d = cv2.ToDouble(null); - return (d1d < d2d) ? -1 : (d1d > d2d) ? 1 : 0; - } - } - - var c1 = Lib.as(v1, IComparable); - var c2 = Lib.as(v2, IComparable); - - if (c1 == null || c2 == null) { - throw new cs.system.ArgumentException("Cannot compare " + getNativeType(v1).ToString() + " and " + getNativeType(v2).ToString()); - } - - return c1.CompareTo(c2); - } - - public static function plus(v1:Dynamic, v2:Dynamic):Dynamic { - if (Std.isOfType(v1, String) || Std.isOfType(v2, String)) - return Std.string(v1) + Std.string(v2); - - if (v1 == null) { - if (v2 == null) - return null; - v1 = 0; - } else if (v2 == null) - v2 = 0; - - var cv1 = Lib.as(v1, IConvertible); - if (cv1 != null) { - var cv2 = Lib.as(v2, IConvertible); - if (cv2 == null) { - throw new cs.system.ArgumentException("Cannot dynamically add " + cs.Lib.getNativeType(v1).ToString() + " and " - + cs.Lib.getNativeType(v2).ToString()); - } - return cv1.ToDouble(null) + cv2.ToDouble(null); - } - - throw new cs.system.ArgumentException("Cannot dynamically add " + v1 + " and " + v2); - } - - public static function slowGetField(obj:Dynamic, field:String, throwErrors:Bool):Dynamic { - if (obj == null) - if (throwErrors) - throw new cs.system.NullReferenceException("Cannot access field \'" + field + "\' of null."); - else - return null; - - var t = Lib.as(obj, cs.system.Type); - var bf = if (t == null) { - var s = Lib.as(obj, String); - if (s != null) - return cs.internal.StringExt.StringRefl.handleGetField(s, field, throwErrors); - t = obj.GetType(); - new cs.Flags(BindingFlags.Instance) | BindingFlags.Public | BindingFlags.FlattenHierarchy; - } else { - if (t == Lib.toNativeType(String) && field == "fromCharCode") - return new cs.internal.Function.Closure(StringExt, field, 0); - - obj = null; - new cs.Flags(BindingFlags.Static) | BindingFlags.Public; - } - - var f = t.GetField(field, bf); - if (f != null) { - return unbox(f.GetValue(obj)); - } else { - var prop = t.GetProperty(field, bf); - if (prop == null) { - var m = t.GetMember(field, bf); - if (m.length == 0 && (field == "__get" || field == "__set")) - m = t.GetMember(field == "__get" ? "get_Item" : "set_Item", bf); - - if (m.Length > 0) { - return new cs.internal.Function.Closure(obj != null ? obj : t, field, 0); - } else { - // COM object handling - if (t.IsCOMObject) { - try { - return t.InvokeMember(field, BindingFlags.GetProperty, null, obj, new cs.NativeArray(0)); - } catch (e:cs.system.Exception) { - // Closures of COM objects not supported currently - } - } - - if (throwErrors) - throw "Cannot access field \'" + field + "\'."; - else - return null; - } - } - return unbox(prop.GetValue(obj, null)); - } - } - - public static function slowHasField(obj:Dynamic, field:String):Bool { - if (obj == null) - return false; - var t = Lib.as(obj, cs.system.Type); - var bf = if (t == null) { - var s = Lib.as(obj, String); - if (s != null) - return cs.internal.StringExt.StringRefl.handleGetField(s, field, false) != null; - t = obj.GetType(); - new cs.Flags(BindingFlags.Instance) | BindingFlags.Public | BindingFlags.FlattenHierarchy; - } else { - if (t == Lib.toNativeType(String)) - return field == "fromCharCode"; - obj = null; - new cs.Flags(BindingFlags.Static) | BindingFlags.Public; - } - var mi = t.GetMember(field, bf); - return mi != null && mi.length > 0; - } - - public static function slowSetField(obj:Dynamic, field:String, value:Dynamic):Dynamic { - if (obj == null) - throw new cs.system.NullReferenceException("Cannot access field \'" + field + "\' of null."); - - var t = Lib.as(obj, cs.system.Type); - var bf = if (t == null) { - t = obj.GetType(); - new cs.Flags(BindingFlags.Instance) | BindingFlags.Public | BindingFlags.FlattenHierarchy; - } else { - obj = null; - new cs.Flags(BindingFlags.Static) | BindingFlags.Public; - } - - var f = t.GetField(field, bf); - if (f != null) { - if (f.FieldType.ToString().StartsWith("haxe.lang.Null")) { - value = mkNullable(value, f.FieldType); - } - if (value != null - && Object.ReferenceEquals(Lib.toNativeType(cs.system.Double), Lib.getNativeType(value)) - && !Object.ReferenceEquals(t, f.FieldType)) { - var ic = Lib.as(value, IConvertible); - value = ic.ToType(f.FieldType, null); - } - - f.SetValue(obj, value); - return value; - } else { - var prop = t.GetProperty(field, bf); - if (prop == null) { - // COM object handling - if (t.IsCOMObject) { - try { - return t.InvokeMember(field, BindingFlags.SetProperty, null, obj, cs.NativeArray.make(value)); - } catch (e:cs.system.Exception) { - // Closures of COM objects not supported currently - } - } - throw "Field \'" + field + "\' not found for writing from Class " + t; - } - - if (prop.PropertyType.ToString().StartsWith("haxe.lang.Null")) { - value = mkNullable(value, prop.PropertyType); - } - if (Object.ReferenceEquals(Lib.toNativeType(cs.system.Double), Lib.getNativeType(value)) - && !Object.ReferenceEquals(t, prop.PropertyType)) { - var ic = Lib.as(value, IConvertible); - value = ic.ToType(prop.PropertyType, null); - } - prop.SetValue(obj, value, null); - - return value; - } - } - - public static function callMethod(obj:Dynamic, methods:NativeArray, methodLength:Int, args:cs.NativeArray):Dynamic { - if (methodLength == 0) - throw "No available methods"; - var length = args.length; - var oargs:NativeArray = new NativeArray(length); - var ts:NativeArray = new NativeArray(length); - var rates:NativeArray = new NativeArray(methods.Length); - - for (i in 0...length) { - oargs[i] = args[i]; - if (args[i] != null) - ts[i] = Lib.getNativeType(args[i]); - } - - var last = 0; - - // first filter by number of parameters and if it is assignable - if (methodLength > 1) { - for (i in 0...methodLength) { - var params = methods[i].GetParameters(); - if (params.Length != length) { - continue; - } else { - var fits = true, crate = 0; - for (i in 0...params.Length) { - var param = params[i].ParameterType; - var strParam = param + ""; - if (param.IsAssignableFrom(ts[i]) || (ts[i] == null && !param.IsValueType)) { - // if it is directly assignable, we'll give it top rate - continue; - } else if (untyped strParam.StartsWith("haxe.lang.Null") - || ((oargs[i] == null || Std.isOfType(oargs[i], IConvertible)) - && cast(untyped __typeof__(IConvertible), Type).IsAssignableFrom(param))) { - // if it needs conversion, give a penalty. TODO rate penalty - crate++; - continue; - } else if (!param.ContainsGenericParameters) { // generics don't appear as assignable, but may be in the end. no rate there. - fits = false; - break; - } - } - - if (fits) { - rates[last] = crate; - methods[last++] = methods[i]; - } - } - } - - methodLength = last; - } else if (methodLength == 1 && methods[0].GetParameters().Length != length) { - methodLength = 0; - } - - // At this time, we should be left with only one method. - // Of course, realistically, we can be left with plenty of methods, if there are lots of variants with IConvertible - // But at this time we still aren't rating the best methods - // FIXME rate best methods - - if (methodLength == 0) - throw "Invalid calling parameters for method " + methods[0].Name; - - var best = cs.system.Double.PositiveInfinity; - var bestMethod = 0; - for (i in 0...methodLength) { - if (rates[i] < best) { - bestMethod = i; - best = rates[i]; - } - } - - methods[0] = methods[bestMethod]; - var params = methods[0].GetParameters(); - for (i in 0...params.Length) { - var param = params[i].ParameterType; - var strParam = param + "", arg = oargs[i]; - if (StringTools.startsWith(strParam, "haxe.lang.Null")) { - oargs[i] = mkNullable(arg, param); - } else if (cast(untyped __typeof__(IConvertible), Type).IsAssignableFrom(param)) { - if (arg == null) { - if (param.IsValueType) - oargs[i] = Activator.CreateInstance(param); - } else if (!cs.Lib.getNativeType(arg).IsAssignableFrom(param)) { - oargs[i] = cast(arg, IConvertible).ToType(param, null); - } - } - } - - if (methods[0].ContainsGenericParameters && Std.isOfType(methods[0], cs.system.reflection.MethodInfo)) { - var m:MethodInfo = cast methods[0]; - var tgs = m.GetGenericArguments(); - for (i in 0...tgs.Length) { - tgs[i] = untyped __typeof__(Dynamic); - } - m = m.MakeGenericMethod(tgs); - var retg = try - m.Invoke(obj, oargs) - catch(e:TargetInvocationException) - throw e.InnerException; - return cs.internal.Runtime.unbox(retg); - } - - var m = methods[0]; - if (obj == null && Std.isOfType(m, cs.system.reflection.ConstructorInfo)) { - var ret = try - cast(m, cs.system.reflection.ConstructorInfo).Invoke(oargs) - catch(e:TargetInvocationException) - throw e.InnerException; - return unbox(ret); - } - - var ret = try - m.Invoke(obj, oargs) - catch(e:TargetInvocationException) - throw e.InnerException; - return unbox(ret); - } - - public static function unbox(dyn:Dynamic):Dynamic { - if (dyn != null && untyped (Lib.getNativeType(dyn) + "").StartsWith("haxe.lang.Null")) { - return dyn.toDynamic(); - } else { - return dyn; - } - } - - #if !erase_generics - @:functionCode(' - if (nullableType.ContainsGenericParameters) - return haxe.lang.Null.ofDynamic(obj); - return nullableType.GetMethod("_ofDynamic").Invoke(null, new object[] { obj }); - ') - public static function mkNullable(obj:Dynamic, nullableType:Type):Dynamic { - return null; - } - #else - public static function mkNullable(obj:Dynamic, nullable:Type):Dynamic { - return obj; // do nothing - } - #end - - public static function slowCallField(obj:Dynamic, field:String, args:cs.NativeArray):Dynamic { - if (field == "toString" && (args == null || args.length == 0)) { - return obj.ToString(); - } - if (args == null) - args = new cs.NativeArray(0); - - var bf:BindingFlags; - var t = Lib.as(obj, cs.system.Type); - if (t == null) { - var s = Lib.as(obj, String); - if (s != null) - return cs.internal.StringExt.StringRefl.handleCallField(untyped s, untyped field, args); - t = untyped obj.GetType(); - bf = new Flags(BindingFlags.Instance) | BindingFlags.Public | BindingFlags.FlattenHierarchy; - } else { - if (t == Lib.toNativeType(String) && field == 'fromCharCode') - return cs.internal.StringExt.fromCharCode(toInt(args[0])); - obj = null; - bf = new Flags(BindingFlags.Static) | BindingFlags.Public; - } - - var mis:NativeArray = untyped t.GetMethods(bf); - var last = 0; - for (i in 0...mis.Length) { - var name = mis[i].Name; - if (name == field) - mis[last++] = mis[i]; - } - - if (last == 0 && (field == "__get" || field == "__set")) { - field = field == "__get" ? "get_Item" : "set_Item"; - for (i in 0...mis.Length) { - var name = mis[i].Name; - if (name == field) { - mis[last++] = mis[i]; - } - } - } - - if (last == 0 && t.IsCOMObject) - return t.InvokeMember(field, BindingFlags.InvokeMethod, null, obj, args); - - if (last == 0) { - throw 'Method "$field" not found on type $t'; - } - - return Runtime.callMethod(obj, mis, last, args); - } - - public static function callField(obj:Dynamic, field:String, fieldHash:Int, args:cs.NativeArray):Dynamic { - var hxObj = Lib.as(obj, HxObject); - if (hxObj != null) - return untyped hxObj.__hx_invokeField(field, (fieldHash == 0) ? FieldLookup.hash(field) : fieldHash, args); - return slowCallField(obj, field, args); - } - - public static function getField(obj:Dynamic, field:String, fieldHash:Int, throwErrors:Bool):Dynamic { - var hxObj = Lib.as(obj, HxObject); - if (hxObj != null) - return untyped hxObj.__hx_getField(field, (fieldHash == 0) ? FieldLookup.hash(field) : fieldHash, throwErrors, false, false); - - return slowGetField(obj, field, throwErrors); - } - - public static function getField_f(obj:Dynamic, field:String, fieldHash:Int, throwErrors:Bool):Float { - var hxObj = Lib.as(obj, HxObject); - if (hxObj != null) - return untyped hxObj.__hx_getField_f(field, (fieldHash == 0) ? FieldLookup.hash(field) : fieldHash, throwErrors, false); - - return toDouble(slowGetField(obj, field, throwErrors)); - } - - public static function setField(obj:Dynamic, field:String, fieldHash:Int, value:Dynamic):Dynamic { - var hxObj = Lib.as(obj, HxObject); - if (hxObj != null) - return untyped hxObj.__hx_setField(field, (fieldHash == 0) ? FieldLookup.hash(field) : fieldHash, value, false); - - return slowSetField(obj, field, value); - } - - public static function setField_f(obj:Dynamic, field:String, fieldHash:Int, value:Float):Float { - var hxObj = Lib.as(obj, HxObject); - if (hxObj != null) - return untyped hxObj.__hx_setField_f(field, (fieldHash == 0) ? FieldLookup.hash(field) : fieldHash, value, false); - - return toDouble(slowSetField(obj, field, value)); - } - - public static function toString(obj:Dynamic):String { - if (obj == null) - return null; - if (Std.isOfType(obj, Bool)) - if (obj) - return "true"; - else - return "false"; - - return untyped obj.ToString(); - } - - #if erase_generics - inline - #end - public static function typeEq(t1:Type, t2:Type):Bool { - if (t1 == null || t2 == null) - return t1 == t2; - #if !erase_generics - var t1i = t1.IsInterface, t2i = t2.IsInterface; - if (t1i != t2i) { - if (t1i) { - var g = getGenericAttr(t1); - if (g != null) - t1 = g.generic; - } else { - var g = getGenericAttr(t2); - if (g != null) - t2 = g.generic; - } - } - #end - if (t1.GetGenericArguments().Length > 0) - t1 = t1.GetGenericTypeDefinition(); - if (t2.GetGenericArguments().Length > 0) - t2 = t2.GetGenericTypeDefinition(); - return Object.ReferenceEquals(t1, t2); - } - - #if !erase_generics - public static function getGenericAttr(t:cs.system.Type):cs.internal.HxObject.GenericInterface { - for (attr in t.GetCustomAttributes(true)) - if (Std.isOfType(attr, cs.internal.HxObject.GenericInterface)) - return cast attr; - return null; - } - #end - - #if !erase_generics - @:functionCode(' - if (obj is To) - return (To) obj; - else if (obj == null) - return default(To); - if (typeof(To) == typeof(double)) - return (To)(object) toDouble(obj); - else if (typeof(To) == typeof(int)) - return (To)(object) toInt(obj); - else if (typeof(To) == typeof(float)) - return (To)(object)(float)toDouble(obj); - else if (typeof(To) == typeof(long)) - return (To)(object)(long)toDouble(obj); - else - return (To) obj; - ') - public static function genericCast(obj:Dynamic):To { - return null; - } - #end - - @:functionCode(' - return (s1 == null ? "null" : s1) + (s2 == null ? "null" : s2); - ') - public static function concat(s1:String, s2:String):String { - return null; - } - - public static function toBool(dyn:Dynamic):Bool { - return if (dyn == null) false else untyped __cs__("(bool){0}", dyn); - } - - // TODO: change from genericCast to getConverter, so we don't need to handle extra boxing associated with it - /*@:functionCode(' - if (typeof(To).TypeHandle == typeof(double).TypeHandle) - return (System.Converter) new System.Converter(toDouble); - else if (typeof(To).TypeHandle == typeof(double).TypeHandle) - return (System.Converter) new System.Converter(toDouble); - else - return (System.Converter) delegate(object obj) { return (To) obj; }; - ') - public static function getConverter():cs.system.Converter - { - return null; - }*/ -} - -@:nativeGen -@:keep @:native("haxe.lang.EmptyObject") enum EmptyObject { - EMPTY; -} diff --git a/std/cs/internal/StringExt.hx b/std/cs/internal/StringExt.hx deleted file mode 100644 index 204dff87e8e..00000000000 --- a/std/cs/internal/StringExt.hx +++ /dev/null @@ -1,223 +0,0 @@ -/* - * 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 cs.internal; - -import cs.internal.Function; - -private typedef NativeString = cs.system.String; - -@:keep @:nativeGen @:native("haxe.lang.StringExt") class StringExt { - @:readOnly static var empty(default, never) = new NativeString(cast 0, 0); - - public static function charAt(me:NativeString, index:Int):NativeString { - if (cast(index, UInt) >= me.Length) - return empty; - else - return new NativeString(me[index], 1); - } - - public static function charCodeAt(me:NativeString, index:Int):Null { - if (cast(index, UInt) >= me.Length) - return null; - else - return cast(me[index], Int); - } - - public static function indexOf(me:NativeString, str:String, ?startIndex:Int):Int { - var sIndex:Int = startIndex != null ? startIndex : 0; - if(str == '') { - if(sIndex < 0) { - sIndex = me.Length + sIndex; - if(sIndex < 0) sIndex = 0; - } - return sIndex > me.Length ? me.Length : sIndex; - } - if (sIndex >= me.Length) - return -1; - return @:privateAccess me.IndexOf(str, sIndex, cs.system.StringComparison.Ordinal); - } - - public static function lastIndexOf(me:NativeString, str:NativeString, ?startIndex:Int):Int { - var sIndex:Int = startIndex == null ? me.Length - 1 : startIndex; - if (sIndex >= me.Length) - sIndex = me.Length - 1; - else if (sIndex < 0) - return -1; - - if (str.Length == 0) { - return startIndex == null || startIndex > me.Length ? me.Length : startIndex; - } - - // TestBaseTypes.hx@133 fix - if (startIndex != null) { - // if the number of letters between start index and the length of the string - // is less than the length of a searched substring - shift start index to the - // left by the difference to avoid OOB access later and save some work - var d = me.Length - sIndex - str.Length; - if (d < 0) { - sIndex += d; - } - - var i = sIndex + 1; - while (i-- > 0) { - var found = true; - for (j in 0...str.Length) { - if (me[i + j] != str[j]) { - found = false; - break; - } - } - - if (found) - return i; - } - - return -1; - } else { - return me.LastIndexOf(untyped str, sIndex, cs.system.StringComparison.Ordinal); - } - return -1; - } - - public static function split(me:NativeString, delimiter:NativeString):Array { - var native:NativeArray; - if (delimiter.Length == 0) { - var len = me.Length; - native = new NativeArray(len); - for (i in 0...len) - native[i] = untyped new NativeString(me[i], 1); - } else { - var str = new NativeArray(1); - str[0] = cast delimiter; - - native = me.Split(str, cs.system.StringSplitOptions.None); - } - - return cs.Lib.array(native); - } - - public static function substr(me:NativeString, pos:Int, ?len:Int):String { - var meLen = me.Length; - var targetLen = meLen; - if (len != null) { - targetLen = len; - if (targetLen == 0 || (pos != 0 && targetLen < 0)) - return ""; - } - - if (pos < 0) { - pos = meLen + pos; - if (pos < 0) - pos = 0; - } else if (targetLen < 0) { - targetLen = meLen + targetLen - pos; - } - - if (pos + targetLen > meLen) { - targetLen = meLen - pos; - } - - if (pos < 0 || targetLen <= 0) - return ""; - - return me.Substring(pos, targetLen); - } - - public static function substring(me:NativeString, startIndex:Int, ?endIndex:Int):String { - var len = me.Length; - var endIdx:Int; - if (endIndex == null) - endIdx = len; - else if ((endIdx = endIndex) < 0) - endIdx = 0; - else if (endIdx > len) - endIdx = len; - - if (startIndex < 0) - startIndex = 0; - else if (startIndex > len) - startIndex = len; - - if (startIndex > endIdx) { - var tmp = startIndex; - startIndex = endIdx; - endIdx = tmp; - } - - return me.Substring(startIndex, endIdx - startIndex); - } - - public static function toString(me:NativeString):NativeString { - return me; - } - - public static function toLowerCase(me:NativeString):String { - return me.ToLowerInvariant(); - } - - public static function toUpperCase(me:NativeString):String { - return me.ToUpperInvariant(); - } - - public static function toNativeString(me:NativeString):NativeString { - return me; - } - - public static function fromCharCode(code:Int):String { - return cs.system.Char.ConvertFromUtf32(code); - // return new NativeString( cast(code,cs.StdTypes.Char16), 1 ); - } -} - -@:keep @:nativeGen @:native('haxe.lang.StringRefl') class StringRefl { - public static var fields = [ - "length", "toUpperCase", "toLowerCase", "charAt", "charCodeAt", "indexOf", "lastIndexOf", "split", "substr", "substring" - ]; - - public static function handleGetField(str:String, f:String, throwErrors:Bool):Dynamic { - switch (f) { - case "length": - return str.length; - case "toUpperCase", "toLowerCase", "charAt", "charCodeAt", "indexOf", "lastIndexOf", "split", "substr", "substring": - return new Closure(str, f, 0); - default: - if (throwErrors) - throw "Field not found: '" + f + "' in String"; - else - return null; - } - } - - public static function handleCallField(str:NativeString, f:String, args:cs.NativeArray):Dynamic { - var _args:cs.NativeArray; - if (args == null) { - _args = cs.NativeArray.make(str); - } else { - _args = new cs.NativeArray(args.length + 1); - for (i in 0...args.length) - _args[i + 1] = args[i]; - _args[0] = str; - } - return Runtime.slowCallField(StringExt, f, _args); - } -} diff --git a/std/cs/io/NativeInput.hx b/std/cs/io/NativeInput.hx deleted file mode 100644 index 743e2a3e336..00000000000 --- a/std/cs/io/NativeInput.hx +++ /dev/null @@ -1,94 +0,0 @@ -/* - * 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 cs.io; - -import haxe.Int64; -import haxe.io.Bytes; -import haxe.io.Eof; -import haxe.io.Error; -import haxe.io.Input; - -class NativeInput extends Input { - public var canSeek(get, never):Bool; - - var stream:cs.system.io.Stream; - var _eof:Bool; - - public function new(stream) { - this.stream = stream; - this._eof = false; - if (!stream.CanRead) - throw "Write-only stream"; - } - - override public function readByte():Int { - var ret = stream.ReadByte(); - if (ret == -1) { - _eof = true; - throw new Eof(); - } - return ret; - } - - override public function readBytes(s:Bytes, pos:Int, len:Int):Int { - if (pos < 0 || len < 0 || pos + len > s.length) - throw Error.OutsideBounds; - var ret = 0; - var data = s.getData(); - try { - ret = stream.Read(data, pos, len); - } catch (e: Dynamic) {} - if (ret == 0) { - _eof = true; - throw new Eof(); - } - return ret; - } - - override public function close():Void { - stream.Close(); - } - - private inline function get_canSeek():Bool { - return stream.CanSeek; - } - - public function seek(p:Int, pos:sys.io.FileSeek):Void { - _eof = false; - var pos = switch (pos) { - case SeekBegin: cs.system.io.SeekOrigin.Begin; - case SeekCur: cs.system.io.SeekOrigin.Current; - case SeekEnd: cs.system.io.SeekOrigin.End; - }; - - stream.Seek(cast(p, Int64), pos); - } - - public function tell():Int { - return cast(stream.Position, Int); - } - - public inline function eof():Bool { - return _eof; - } -} diff --git a/std/cs/io/NativeOutput.hx b/std/cs/io/NativeOutput.hx deleted file mode 100644 index 4221e02ecff..00000000000 --- a/std/cs/io/NativeOutput.hx +++ /dev/null @@ -1,74 +0,0 @@ -/* - * 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 cs.io; - -import haxe.Int64; -import haxe.io.Bytes; -import haxe.io.Output; - -class NativeOutput extends Output { - var canSeek(get, never):Bool; - - var stream:cs.system.io.Stream; - - public function new(stream) { - this.stream = stream; - if (!stream.CanWrite) - throw "Read-only stream"; - } - - override public function writeByte(c:Int):Void { - stream.WriteByte(cast c); - } - - override public function close():Void { - stream.Close(); - } - - override public function flush():Void { - stream.Flush(); - } - - override public function prepare(nbytes:Int):Void { - // TODO see if implementation is correct - stream.SetLength(haxe.Int64.add(stream.Length, cast(nbytes, Int64))); - } - - private inline function get_canSeek():Bool { - return stream.CanSeek; - } - - public function seek(p:Int, pos:sys.io.FileSeek):Void { - var pos = switch (pos) { - case SeekBegin: cs.system.io.SeekOrigin.Begin; - case SeekCur: cs.system.io.SeekOrigin.Current; - case SeekEnd: cs.system.io.SeekOrigin.End; - }; - - stream.Seek(cast(p, Int64), pos); - } - - public function tell():Int { - return cast(stream.Position, Int); - } -} diff --git a/std/cs/types/Char16.hx b/std/cs/types/Char16.hx deleted file mode 100644 index 23060aecf55..00000000000 --- a/std/cs/types/Char16.hx +++ /dev/null @@ -1,25 +0,0 @@ -/* - * 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 cs.types; - -typedef Char16 = cs.StdTypes.Char16; diff --git a/std/cs/types/Int16.hx b/std/cs/types/Int16.hx deleted file mode 100644 index bb1ba494d05..00000000000 --- a/std/cs/types/Int16.hx +++ /dev/null @@ -1,25 +0,0 @@ -/* - * 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 cs.types; - -typedef Int16 = cs.StdTypes.Int16; diff --git a/std/cs/types/Int64.hx b/std/cs/types/Int64.hx deleted file mode 100644 index 5bd867a80aa..00000000000 --- a/std/cs/types/Int64.hx +++ /dev/null @@ -1,25 +0,0 @@ -/* - * 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 cs.types; - -typedef Int64 = cs.StdTypes.Int64; diff --git a/std/cs/types/Int8.hx b/std/cs/types/Int8.hx deleted file mode 100644 index d0309f1a8fb..00000000000 --- a/std/cs/types/Int8.hx +++ /dev/null @@ -1,25 +0,0 @@ -/* - * 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 cs.types; - -typedef Int8 = cs.StdTypes.Int8; diff --git a/std/cs/types/UInt16.hx b/std/cs/types/UInt16.hx deleted file mode 100644 index fc8de77c3c1..00000000000 --- a/std/cs/types/UInt16.hx +++ /dev/null @@ -1,25 +0,0 @@ -/* - * 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 cs.types; - -typedef UInt16 = cs.StdTypes.UInt16; diff --git a/std/cs/types/UInt64.hx b/std/cs/types/UInt64.hx deleted file mode 100644 index 62f4b585e83..00000000000 --- a/std/cs/types/UInt64.hx +++ /dev/null @@ -1,25 +0,0 @@ -/* - * 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 cs.types; - -typedef UInt64 = cs.StdTypes.UInt64; diff --git a/std/cs/types/UInt8.hx b/std/cs/types/UInt8.hx deleted file mode 100644 index e3c9961dc38..00000000000 --- a/std/cs/types/UInt8.hx +++ /dev/null @@ -1,25 +0,0 @@ -/* - * 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 cs.types; - -typedef UInt8 = cs.StdTypes.UInt8; diff --git a/std/haxe/Serializer.hx b/std/haxe/Serializer.hx index f1ab2d06132..411b85f744a 100644 --- a/std/haxe/Serializer.hx +++ b/std/haxe/Serializer.hx @@ -257,14 +257,14 @@ class Serializer { } if (useCache && serializeRef(v)) return; - switch (#if (neko || cs || python) Type.getClassName(c) #else c #end) { - case #if (neko || cs || python) "Array" #else cast Array #end: + switch (#if (neko || python) Type.getClassName(c) #else c #end) { + case #if (neko || python) "Array" #else cast Array #end: var ucount = 0; buf.add("a"); #if (flash || python || hl) var v:Array = v; #end - var l = #if (neko || flash || php || cs || java || python || hl || lua || eval) v.length #elseif cpp v.__length() #else __getField(v, + var l = #if (neko || flash || php || java || python || hl || lua || eval) v.length #elseif cpp v.__length() #else __getField(v, "length") #end; for (i in 0...l) { if (v[i] == null) @@ -291,17 +291,17 @@ class Serializer { } } buf.add("h"); - case #if (neko || cs || python) "haxe.ds.List" #else cast List #end: + case #if (neko || python) "haxe.ds.List" #else cast List #end: buf.add("l"); var v:List = v; for (i in v) serialize(i); buf.add("h"); - case #if (neko || cs || python) "Date" #else cast Date #end: + case #if (neko || python) "Date" #else cast Date #end: var d:Date = v; buf.add("v"); buf.add(d.getTime()); - case #if (neko || cs || python) "haxe.ds.StringMap" #else cast haxe.ds.StringMap #end: + case #if (neko || python) "haxe.ds.StringMap" #else cast haxe.ds.StringMap #end: buf.add("b"); var v:haxe.ds.StringMap = v; for (k in v.keys()) { @@ -309,7 +309,7 @@ class Serializer { serialize(v.get(k)); } buf.add("h"); - case #if (neko || cs || python) "haxe.ds.IntMap" #else cast haxe.ds.IntMap #end: + case #if (neko || python) "haxe.ds.IntMap" #else cast haxe.ds.IntMap #end: buf.add("q"); var v:haxe.ds.IntMap = v; for (k in v.keys()) { @@ -318,7 +318,7 @@ class Serializer { serialize(v.get(k)); } buf.add("h"); - case #if (neko || cs || python) "haxe.ds.ObjectMap" #else cast haxe.ds.ObjectMap #end: + case #if (neko || python) "haxe.ds.ObjectMap" #else cast haxe.ds.ObjectMap #end: buf.add("M"); var v:haxe.ds.ObjectMap = v; for (k in v.keys()) { @@ -333,7 +333,7 @@ class Serializer { serialize(v.get(k)); } buf.add("h"); - case #if (neko || cs || python) "haxe.io.Bytes" #else cast haxe.io.Bytes #end: + case #if (neko || python) "haxe.io.Bytes" #else cast haxe.io.Bytes #end: var v:haxe.io.Bytes = v; #if neko var chars = new String(base_encode(v.getData(), untyped BASE64.__s)); @@ -389,7 +389,7 @@ class Serializer { if (#if flash try v.hxSerialize != null catch (e:Dynamic) - false #elseif (cs || java || python) Reflect.hasField(v, + false #elseif (java || python) Reflect.hasField(v, "hxSerialize") #elseif php php.Global.method_exists(v, 'hxSerialize') #else v.hxSerialize != null #end) { buf.add("C"); serializeString(Type.getClassName(c)); @@ -499,7 +499,7 @@ class Serializer { #end } } - #elseif (java || cs || python || hl || eval) + #elseif (java || python || hl || eval) if (useEnumIndex) { buf.add(":"); buf.add(Type.enumIndex(v)); diff --git a/std/haxe/crypto/Md5.hx b/std/haxe/crypto/Md5.hx index 303913884b5..38194c31b69 100644 --- a/std/haxe/crypto/Md5.hx +++ b/std/haxe/crypto/Md5.hx @@ -93,11 +93,11 @@ class Md5 { // preallocate size var blksSize = nblk * 16; - #if (neko || cs || cpp || java || hl) + #if (neko || cpp || java || hl) blks[blksSize - 1] = 0; #end - #if !(cpp || cs || hl) // C++ and C# will already initialize them with zeroes. + #if !(cpp || hl) // C++ will already initialize them with zeroes. for (i in 0...blksSize) blks[i] = 0; #end @@ -126,11 +126,11 @@ class Md5 { // preallocate size var blksSize = nblk * 16; - #if (neko || eval || cs || cpp || java || hl) + #if (neko || eval || cpp || java || hl) blks[blksSize - 1] = 0; #end - #if !(cpp || cs || hl) // C++ and C# will already initialize them with zeroes. + #if !(cpp || hl) // C++ will already initialize them with zeroes. for (i in 0...blksSize) blks[i] = 0; #end diff --git a/std/haxe/display/Display.hx b/std/haxe/display/Display.hx index 3de828f3d6f..9c6c57f630b 100644 --- a/std/haxe/display/Display.hx +++ b/std/haxe/display/Display.hx @@ -296,7 +296,6 @@ enum abstract Platform(String) { var Flash = "flash"; var Php = "php"; var Cpp = "cpp"; - var Cs = "cs"; var Java = "java"; var Python = "python"; var Hl = "hl"; diff --git a/std/haxe/ds/IntMap.hx b/std/haxe/ds/IntMap.hx index 8197e098ee7..d253a94a54d 100644 --- a/std/haxe/ds/IntMap.hx +++ b/std/haxe/ds/IntMap.hx @@ -58,7 +58,7 @@ extern class IntMap implements haxe.Constraints.IMap { /** See `Map.keys` - (cs, java) Implementation detail: Do not `set()` any new value while + (java) Implementation detail: Do not `set()` any new value while iterating, as it may cause a resize, which will break iteration. **/ function keys():Iterator; @@ -66,7 +66,7 @@ extern class IntMap implements haxe.Constraints.IMap { /** See `Map.iterator` - (cs, java) Implementation detail: Do not `set()` any new value while + (java) Implementation detail: Do not `set()` any new value while iterating, as it may cause a resize, which will break iteration. **/ function iterator():Iterator; diff --git a/std/haxe/ds/ObjectMap.hx b/std/haxe/ds/ObjectMap.hx index ebae1d4950f..686d3e23deb 100644 --- a/std/haxe/ds/ObjectMap.hx +++ b/std/haxe/ds/ObjectMap.hx @@ -61,7 +61,7 @@ extern class ObjectMap implements haxe.Constraints.IMap { /** See `Map.keys` - (cs, java) Implementation detail: Do not `set()` any new value while + (java) Implementation detail: Do not `set()` any new value while iterating, as it may cause a resize, which will break iteration. **/ function keys():Iterator; @@ -69,7 +69,7 @@ extern class ObjectMap implements haxe.Constraints.IMap { /** See `Map.iterator` - (cs, java) Implementation detail: Do not `set()` any new value while + (java) Implementation detail: Do not `set()` any new value while iterating, as it may cause a resize, which will break iteration. **/ function iterator():Iterator; diff --git a/std/haxe/ds/StringMap.hx b/std/haxe/ds/StringMap.hx index 11fb14a5c53..811d3433a57 100644 --- a/std/haxe/ds/StringMap.hx +++ b/std/haxe/ds/StringMap.hx @@ -58,7 +58,7 @@ extern class StringMap implements haxe.Constraints.IMap { /** See `Map.keys` - (cs, java) Implementation detail: Do not `set()` any new value while + (java) Implementation detail: Do not `set()` any new value while iterating, as it may cause a resize, which will break iteration. **/ function keys():Iterator; @@ -66,7 +66,7 @@ extern class StringMap implements haxe.Constraints.IMap { /** See `Map.iterator` - (cs, java) Implementation detail: Do not `set()` any new value while + (java) Implementation detail: Do not `set()` any new value while iterating, as it may cause a resize, which will break iteration. **/ function iterator():Iterator; diff --git a/std/haxe/ds/Vector.hx b/std/haxe/ds/Vector.hx index 08c1a793dcf..14b60b90ce6 100644 --- a/std/haxe/ds/Vector.hx +++ b/std/haxe/ds/Vector.hx @@ -31,8 +31,6 @@ private typedef VectorData = flash.Vector #elseif neko neko.NativeArray - #elseif cs - cs.NativeArray #elseif java java.NativeArray #elseif lua @@ -68,8 +66,6 @@ abstract Vector(VectorData) { this = untyped __dollar__amake(length); #elseif js this = js.Syntax.construct(Array, length); - #elseif cs - this = new cs.NativeArray(length); #elseif java this = new java.NativeArray(length); #elseif cpp @@ -104,8 +100,6 @@ abstract Vector(VectorData) { this = new flash.Vector(length, true); #elseif neko this = untyped __dollar__amake(length); - #elseif cs - this = new cs.NativeArray(length); #elseif java this = new java.NativeArray(length); #elseif cpp @@ -167,8 +161,6 @@ abstract Vector(VectorData) { inline function get_length():Int { #if neko return untyped __dollar__asize(this); - #elseif cs - return this.Length; #elseif java return this.length; #elseif python @@ -191,13 +183,11 @@ abstract Vector(VectorData) { The results are unspecified if `length` results in out-of-bounds access, or if `src` or `dest` are null **/ - public static #if (cs || java || neko || cpp || eval) inline #end function blit(src:Vector, srcPos:Int, dest:Vector, destPos:Int, len:Int):Void { + public static #if (java || neko || cpp || eval) inline #end function blit(src:Vector, srcPos:Int, dest:Vector, destPos:Int, len:Int):Void { #if neko untyped __dollar__ablit(dest, destPos, src, srcPos, len); #elseif java java.lang.System.arraycopy(src, srcPos, dest, destPos, len); - #elseif cs - cs.system.Array.Copy(cast src, srcPos, cast dest, destPos, len); #elseif cpp dest.toData().blit(destPos, src.toData(), srcPos, len); #elseif eval @@ -291,8 +281,6 @@ abstract Vector(VectorData) { return fromData(flash.Vector.ofArray(array)); #elseif java return fromData(java.Lib.nativeArray(array, false)); - #elseif cs - return fromData(cs.Lib.nativeArray(array, false)); #elseif cpp return cast array.copy(); #elseif js @@ -315,7 +303,7 @@ abstract Vector(VectorData) { `a[i] == a.copy()[i]` is true for any valid `i`. However, `a == a.copy()` is always false. **/ - #if cs extern #end public inline function copy():Vector { + extern public inline function copy():Vector { #if eval return fromData(this.copy()); #else @@ -338,7 +326,7 @@ abstract Vector(VectorData) { If `sep` is null, the result is unspecified. **/ - #if cs extern #end public inline function join(sep:String):String { + extern public inline function join(sep:String):String { #if (flash10 || cpp || eval) return this.join(sep); #else @@ -361,7 +349,7 @@ abstract Vector(VectorData) { If `f` is null, the result is unspecified. **/ - #if cs extern #end public inline function map(f:T->S):Vector { + extern public inline function map(f:T->S):Vector { #if eval return fromData(this.map(f)); #else @@ -389,7 +377,7 @@ abstract Vector(VectorData) { If `f` is null, the result is unspecified. **/ public inline function sort(f:T->T->Int):Void { - #if (neko || cs || java || eval) + #if (neko || java || eval) throw "not yet supported"; #elseif lua haxe.ds.ArraySort.sort(cast this, f); diff --git a/std/haxe/io/Bytes.hx b/std/haxe/io/Bytes.hx index 74443cf5f3a..fdfdf4290fe 100644 --- a/std/haxe/io/Bytes.hx +++ b/std/haxe/io/Bytes.hx @@ -70,8 +70,6 @@ class Bytes { untyped b[pos] = v; #elseif java b[pos] = cast v; - #elseif cs - b[pos] = cast v; #elseif python python.Syntax.arraySet(b, pos, v & 0xFF); #else @@ -103,8 +101,6 @@ class Bytes { b.writeBytes(src.b, srcpos, len); #elseif java java.lang.System.arraycopy(src.b, srcpos, b, pos, len); - #elseif cs - cs.system.Array.Copy(src.b, srcpos, b, pos, len); #elseif python python.Syntax.code("self.b[{0}:{0}+{1}] = src.b[srcpos:srcpos+{1}]", pos, len); #elseif cpp @@ -168,17 +164,13 @@ class Bytes { var newarr = new java.NativeArray(len); java.lang.System.arraycopy(b, pos, newarr, 0, len); return new Bytes(len, newarr); - #elseif cs - var newarr = new cs.NativeArray(len); - cs.system.Array.Copy(b, pos, newarr, 0, len); - return new Bytes(len, newarr); #elseif python return new Bytes(len, python.Syntax.arrayAccess(b, pos, pos + len)); #else return new Bytes(len, b.slice(pos, pos + len)); #end } - + /** Returns `0` if the bytes of `this` instance and the bytes of `other` are identical. @@ -220,7 +212,6 @@ class Bytes { b1.endian = flash.utils.Endian.LITTLE_ENDIAN; b2.endian = flash.utils.Endian.LITTLE_ENDIAN; return length - other.length; - // #elseif cs // TODO: memcmp if unsafe flag is on #elseif cpp return b.memcmp(other.b); @@ -428,13 +419,6 @@ class Bytes { var result:String = ""; untyped __global__.__hxcpp_string_of_bytes(b, result, pos, len); return result; - #elseif cs - switch (encoding) { - case UTF8 | null: - return cs.system.text.Encoding.UTF8.GetString(b, pos, len); - case RawNative: - return cs.system.text.Encoding.Unicode.GetString(b, pos, len); - } #elseif java try { switch (encoding) { @@ -505,8 +489,6 @@ class Bytes { #elseif flash b.position = 0; return b.toString(); - #elseif cs - return cs.system.text.Encoding.UTF8.GetString(b, 0, length); #elseif java try { return new String(b, 0, length, "UTF-8"); @@ -558,8 +540,6 @@ class Bytes { if (length > 0) cpp.NativeArray.setSize(a, length); return new Bytes(length, a); - #elseif cs - return new Bytes(length, new cs.NativeArray(length)); #elseif java return new Bytes(length, new java.NativeArray(length)); #elseif python @@ -591,14 +571,6 @@ class Bytes { var a = new BytesData(); untyped __global__.__hxcpp_bytes_of_string(a, s); return new Bytes(a.length, a); - #elseif cs - var b = switch (encoding) { - case UTF8 | null: - cs.system.text.Encoding.UTF8.GetBytes(s); - case RawNative: - cs.system.text.Encoding.Unicode.GetBytes(s); - }; - return new Bytes(b.Length, b); #elseif java try { var b:BytesData = switch (encoding) { @@ -658,8 +630,6 @@ class Bytes { return new Bytes(b.length, b); #elseif neko return new Bytes(untyped __dollar__ssize(b), b); - #elseif cs - return new Bytes(b.Length, b); #else return new Bytes(b.length, b); #end diff --git a/std/haxe/io/BytesBuffer.hx b/std/haxe/io/BytesBuffer.hx index 2400c4b07d5..7a654e218d9 100644 --- a/std/haxe/io/BytesBuffer.hx +++ b/std/haxe/io/BytesBuffer.hx @@ -29,8 +29,6 @@ class BytesBuffer { var b:flash.utils.ByteArray; #elseif cpp var b:BytesData; - #elseif cs - var b:cs.system.io.MemoryStream; #elseif java var b:java.io.ByteArrayOutputStream; #elseif python @@ -50,8 +48,6 @@ class BytesBuffer { b.endian = flash.utils.Endian.LITTLE_ENDIAN; #elseif cpp b = new BytesData(); - #elseif cs - b = new cs.system.io.MemoryStream(); #elseif java b = new java.io.ByteArrayOutputStream(); #elseif python @@ -66,8 +62,6 @@ class BytesBuffer { if (@:privateAccess StringBuf.__get_length != null) return untyped StringBuf.__get_length(b); return untyped __dollar__ssize(StringBuf.__to_string(b)); - #elseif cs - return haxe.Int64.toInt(b.Length); #elseif java return b.size(); #else @@ -82,8 +76,6 @@ class BytesBuffer { b.writeByte(byte); #elseif cpp b.push(untyped byte); - #elseif cs - b.WriteByte(cast byte); #elseif java b.write(byte); #elseif python @@ -98,8 +90,6 @@ class BytesBuffer { untyped StringBuf.__add(b, src.getData()); #elseif flash b.writeBytes(src.getData()); - #elseif cs - b.Write(src.getData(), 0, src.length); #elseif java b.write(src.getData(), 0, src.length); #elseif js @@ -177,8 +167,6 @@ class BytesBuffer { #elseif flash if (len > 0) b.writeBytes(src.getData(), pos, len); - #elseif cs - b.Write(src.getData(), pos, len); #elseif java b.write(src.getData(), pos, len); #elseif js @@ -208,9 +196,6 @@ class BytesBuffer { #elseif flash var bytes = new Bytes(b.length, b); b.position = 0; - #elseif cs - var buf = b.GetBuffer(); - var bytes = new Bytes(cast b.Length, buf); #elseif java var buf = b.toByteArray(); var bytes = new Bytes(buf.length, buf); diff --git a/std/haxe/io/BytesData.hx b/std/haxe/io/BytesData.hx index a7a443c713f..49de7e2cd41 100644 --- a/std/haxe/io/BytesData.hx +++ b/std/haxe/io/BytesData.hx @@ -30,8 +30,6 @@ typedef BytesData = flash.utils.ByteArray; typedef BytesData = Array; #elseif java typedef BytesData = java.NativeArray; -#elseif cs -typedef BytesData = cs.NativeArray; #elseif python typedef BytesData = python.Bytearray; #elseif js diff --git a/std/haxe/io/BytesInput.hx b/std/haxe/io/BytesInput.hx index 9d63d365855..b8d24fb260c 100644 --- a/std/haxe/io/BytesInput.hx +++ b/std/haxe/io/BytesInput.hx @@ -138,15 +138,6 @@ class BytesInput extends Input { java.lang.System.arraycopy(this.b, this.pos, buf.getData(), pos, len); this.pos += len; this.len -= len; - #elseif cs - var avail:Int = this.len; - if (len > avail) - len = avail; - if (len == 0) - throw new Eof(); - cs.system.Array.Copy(this.b, this.pos, buf.getData(), pos, len); - this.pos += len; - this.len -= len; #else if (this.len == 0 && len > 0) throw new Eof(); diff --git a/std/haxe/io/FPHelper.hx b/std/haxe/io/FPHelper.hx index 0d7af0e8722..88d47e999ac 100644 --- a/std/haxe/io/FPHelper.hx +++ b/std/haxe/io/FPHelper.hx @@ -31,7 +31,7 @@ class FPHelper { // stored in helper #elseif neko static var i64tmp = new sys.thread.Tls(); - #elseif !(java || cs || cpp) + #elseif !(java || cpp) static var i64tmp = Int64.ofInt(0); static inline var LN2 = 0.6931471805599453; // Math.log(2) @@ -95,7 +95,7 @@ class FPHelper { av = av / Math.pow(2, exp) - 1.0; } var sig = Math.fround(av * 4503599627370496.); // 2^52 - // Note: If "sig" is outside of the signed Int32 range, the result is unspecified in HL, C#, Java and Neko, + // Note: If "sig" is outside of the signed Int32 range, the result is unspecified in HL, Java and Neko. var sig_l = Std.int(sig); var sig_h = Std.int(sig / 4294967296.0); i64.set_low(sig_l); @@ -146,15 +146,6 @@ class FPHelper { #end #elseif cpp return untyped __global__.__hxcpp_reinterpret_le_int32_as_float32(i); - #elseif cs - var helper = new SingleHelper(0); - if (cs.system.BitConverter.IsLittleEndian) { - helper.i = i; - } else { - helper.i = ((i >>> 24) & 0xFF) | (((i >> 16) & 0xFF) << 8) | (((i >> 8) & 0xFF) << 16) | ((i & 0xFF) << 24); - } - - return helper.f; #elseif java return java.lang.Float.FloatClass.intBitsToFloat(i); #elseif flash @@ -184,14 +175,6 @@ class FPHelper { #end #elseif cpp return untyped __global__.__hxcpp_reinterpret_float32_as_le_int32(f); - #elseif cs - var helper = new SingleHelper(f); - if (cs.system.BitConverter.IsLittleEndian) { - return helper.i; - } else { - var i = helper.i; - return ((i >>> 24) & 0xFF) | (((i >> 16) & 0xFF) << 8) | (((i >> 8) & 0xFF) << 16) | ((i & 0xFF) << 24); - } #elseif java return java.lang.Float.FloatClass.floatToRawIntBits(f); #elseif flash @@ -231,17 +214,6 @@ class FPHelper { #end #elseif cpp return untyped __global__.__hxcpp_reinterpret_le_int32s_as_float64(low, high); - #elseif cs - var helper = new FloatHelper(0); - if (cs.system.BitConverter.IsLittleEndian) { - helper.i = haxe.Int64.make(high, low); - } else { - var i1 = high, i2 = low; - var j2 = ((i1 >>> 24) & 0xFF) | (((i1 >> 16) & 0xFF) << 8) | (((i1 >> 8) & 0xFF) << 16) | ((i1 & 0xFF) << 24); - var j1 = ((i2 >>> 24) & 0xFF) | (((i2 >> 16) & 0xFF) << 8) | (((i2 >> 8) & 0xFF) << 16) | ((i2 & 0xFF) << 24); - helper.i = haxe.Int64.make(j1, j2); - } - return helper.f; #elseif java return java.lang.Double.DoubleClass.longBitsToDouble(Int64.make(high, low)); #elseif flash @@ -296,18 +268,6 @@ class FPHelper { untyped __global__.__hxcpp_reinterpret_float64_as_le_int32_low(v)); #elseif java return java.lang.Double.DoubleClass.doubleToRawLongBits(v); - #elseif cs - var helper = new FloatHelper(v); - if (cs.system.BitConverter.IsLittleEndian) { - return helper.i; - } else { - var i = helper.i; - var i1 = haxe.Int64.getHigh(i), i2 = haxe.Int64.getLow(i); - var j2 = ((i1 >>> 24) & 0xFF) | (((i1 >> 16) & 0xFF) << 8) | (((i1 >> 8) & 0xFF) << 16) | ((i1 & 0xFF) << 24); - var j1 = ((i2 >>> 24) & 0xFF) | (((i2 >> 16) & 0xFF) << 8) | (((i2 >> 8) & 0xFF) << 16) | ((i2 & 0xFF) << 24); - - return haxe.Int64.make(j1, j2); - } #elseif flash var helper = helper; helper.position = 0; @@ -332,31 +292,3 @@ class FPHelper { #end } } - -#if cs -@:meta(System.Runtime.InteropServices.StructLayout(System.Runtime.InteropServices.LayoutKind.Explicit)) -@:nativeGen @:struct private class SingleHelper { - @:meta(System.Runtime.InteropServices.FieldOffset(0)) - public var i:Int; - @:meta(System.Runtime.InteropServices.FieldOffset(0)) - public var f:Single; - - public function new(f:Single) { - this.i = 0; - this.f = f; - } -} - -@:meta(System.Runtime.InteropServices.StructLayout(System.Runtime.InteropServices.LayoutKind.Explicit)) -@:nativeGen @:struct private class FloatHelper { - @:meta(System.Runtime.InteropServices.FieldOffset(0)) - public var i:haxe.Int64; - @:meta(System.Runtime.InteropServices.FieldOffset(0)) - public var f:Float; - - public function new(f:Float) { - this.i = haxe.Int64.ofInt(0); - this.f = f; - } -} -#end diff --git a/std/haxe/io/Input.hx b/std/haxe/io/Input.hx index 06bb6d0d30a..ee90aa2fe0c 100644 --- a/std/haxe/io/Input.hx +++ b/std/haxe/io/Input.hx @@ -37,9 +37,7 @@ class Input { **/ public var bigEndian(default, set):Bool; - #if cs - private var helper:BytesData; - #elseif java + #if java private var helper:java.nio.ByteBuffer; #end diff --git a/std/haxe/macro/Compiler.hx b/std/haxe/macro/Compiler.hx index 854082e4e31..910985557f2 100644 --- a/std/haxe/macro/Compiler.hx +++ b/std/haxe/macro/Compiler.hx @@ -150,15 +150,6 @@ class Compiler { #end } - /** - Adds an argument to be passed to the native compiler (e.g. `-javac-arg` for Java). - **/ - public static function addNativeArg(argument:String) { - #if (neko || eval) - load("add_native_arg", 1)(argument); - #end - } - /** Includes all modules in package `pack` in the compilation. @@ -691,8 +682,7 @@ enum Platform { Flash; Php; Cpp; - Cs; - Java; + Jvm; Python; Hl; Eval; diff --git a/std/haxe/rtti/Meta.hx b/std/haxe/rtti/Meta.hx index 89c046d2be5..7292e408f2d 100644 --- a/std/haxe/rtti/Meta.hx +++ b/std/haxe/rtti/Meta.hx @@ -46,8 +46,6 @@ class Meta { private static function isInterface(t:Dynamic):Bool { #if java return java.Lib.toNativeType(t).isInterface(); - #elseif cs - return cs.Lib.toNativeType(t).IsInterface; #else throw "Something went wrong"; #end @@ -56,7 +54,7 @@ class Meta { private static function getMeta(t:Dynamic):MetaObject { #if php return php.Boot.getMeta(t.phpClassName); - #elseif (java || cs) + #elseif java var ret = Reflect.field(t, "__meta__"); if (ret == null && Std.isOfType(t, Class)) { if (isInterface(t)) { diff --git a/std/java/Boot.hx b/std/java/Boot.hx index 8d75e7d7b47..72e64d075f5 100644 --- a/std/java/Boot.hx +++ b/std/java/Boot.hx @@ -22,12 +22,8 @@ package java; -import java.internal.Function; -import java.internal.HxObject; -import java.internal.Runtime; import java.Lib; import java.Init; -// import java.internal.StringExt; import java.StdTypes; import Reflect; import Map; @@ -43,8 +39,6 @@ import java.lang.Integer; import java.lang.Long; import java.lang.Short; import java.lang.Throwable; -import java.internal.StringExt; -import java.internal.FieldLookup; @:dox(hide) extern class Boot {} diff --git a/std/java/_std/EReg.hx b/std/java/_std/EReg.hx deleted file mode 100644 index 04e4e563165..00000000000 --- a/std/java/_std/EReg.hx +++ /dev/null @@ -1,192 +0,0 @@ -/* - * 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. - */ - -import java.util.regex.*; - -using StringTools; - -@:coreApi class EReg { - private var pattern:String; - private var matcher:Matcher; - private var cur:String; - private var isGlobal:Bool; - - public function new(r:String, opt:String) { - var flags = 0; - for (i in 0...opt.length) { - switch (StringTools.fastCodeAt(opt, i)) { - case 'i'.code: - flags |= Pattern.CASE_INSENSITIVE; - case 'm'.code: - flags |= Pattern.MULTILINE; - case 's'.code: - flags |= Pattern.DOTALL; - case 'g'.code: - isGlobal = true; - } - } - - flags |= Pattern.UNICODE_CASE; - #if !android // see https://github.com/HaxeFoundation/haxe/issues/7632 - flags |= Pattern.UNICODE_CHARACTER_CLASS; - #end - matcher = Pattern.compile(convert(r), flags).matcher(""); - pattern = r; - } - - private static function convert(r:String):String { - // some references of the implementation: - // http://stackoverflow.com/questions/809647/java-vs-javascript-regex-problem - // http://stackoverflow.com/questions/4788413/how-to-convert-javascript-regex-to-safe-java-regex - // Some necessary changes: - // - // \0 -> \x00 - // \v -> \x0b - // [^] -> [\s\S] - // unescaped ', " -> \', \" - /* FIXME - var pat = new StringBuf(); - var len = r.length; - var i = 0; - while (i < len) - { - var c = StringTools.fastCodeAt(r, i++); - switch(c) - { - case '\\'.code: //escape-sequence - - } - } - */ - - return r; - } - - public function match(s:String):Bool { - cur = s; - matcher = matcher.reset(s); - return matcher.find(); - } - - public function matched(n:Int):String { - if (n == 0) - return matcher.group(); - else - return matcher.group(n); - } - - public function matchedLeft():String { - return untyped cur.substring(0, matcher.start()); - } - - public function matchedRight():String { - return untyped cur.substring(matcher.end(), cur.length); - } - - public function matchedPos():{pos:Int, len:Int} { - var start = matcher.start(); - return {pos: start, len: matcher.end() - start}; - } - - public function matchSub(s:String, pos:Int, len:Int = -1):Bool { - matcher = matcher.reset(len < 0 ? s : s.substr(0, pos + len)); - cur = s; - return matcher.find(pos); - } - - public function split(s:String):Array { - if (isGlobal) { - var ret = []; - matcher.reset(s); - matcher = matcher.useAnchoringBounds(false).useTransparentBounds(true); - var copyOffset = 0; - while (true) { - if (!matcher.find()) { - ret.push(s.substring(copyOffset, s.length)); - break; - } - ret.push(s.substring(copyOffset, matcher.start())); - var nextStart = matcher.end(); - copyOffset = nextStart; - if (nextStart == matcher.regionStart()) { - nextStart++; // zero-length match - shift region one forward - } - if (nextStart >= s.length) { - ret.push(""); - break; - } - matcher.region(nextStart, s.length); - } - return ret; - } else { - var m = matcher; - m.reset(s); - if (m.find()) { - return untyped [s.substring(0, m.start()), s.substring(m.end(), s.length)]; - } else { - return [s]; - } - } - } - - inline function start(group:Int):Int { - return matcher.start(group); - } - - inline function len(group:Int):Int { - return matcher.end(group) - matcher.start(group); - } - - public function replace(s:String, by:String):String { - matcher.reset(s); - by = by.replace("\\", "\\\\").replace("$$", "\\$"); - return isGlobal ? matcher.replaceAll(by) : matcher.replaceFirst(by); - } - - public function map(s:String, f:EReg->String):String { - var offset = 0; - var buf = new StringBuf(); - do { - if (offset >= s.length) - break; - else if (!matchSub(s, offset)) { - buf.add(s.substr(offset)); - break; - } - var p = matchedPos(); - buf.add(s.substr(offset, p.pos - offset)); - buf.add(f(this)); - if (p.len == 0) { - buf.add(s.substr(p.pos, 1)); - offset = p.pos + 1; - } else - offset = p.pos + p.len; - } while (isGlobal); - if (!isGlobal && offset > 0 && offset < s.length) - buf.add(s.substr(offset)); - return buf.toString(); - } - - public static inline function escape(s:String):String { - return Pattern.quote(s); - } -} diff --git a/std/java/_std/Reflect.hx b/std/java/_std/Reflect.hx deleted file mode 100644 index 00f8002a4a1..00000000000 --- a/std/java/_std/Reflect.hx +++ /dev/null @@ -1,145 +0,0 @@ -/* - * 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. - */ - -import java.internal.Function; -import java.internal.HxObject; -import java.internal.Runtime; -import java.Boot; - -@:coreApi class Reflect { - public static function hasField(o:Dynamic, field:String):Bool { - if (Std.isOfType(o, IHxObject)) { - return untyped (o : IHxObject).__hx_getField(field, false, true, false) != Runtime.undefined; - } - return Runtime.slowHasField(o, field); - } - - @:keep - public static function field(o:Dynamic, field:String):Dynamic { - if (Std.isOfType(o, IHxObject)) { - return untyped (o : IHxObject).__hx_getField(field, false, false, false); - } - return Runtime.slowGetField(o, field, false); - } - - @:keep - public static function setField(o:Dynamic, field:String, value:Dynamic):Void { - if (Std.isOfType(o, IHxObject)) { - untyped (o : IHxObject).__hx_setField(field, value, false); - } else { - Runtime.slowSetField(o, field, value); - } - } - - public static function getProperty(o:Dynamic, field:String):Dynamic { - if (o == null || field == null) { - return null; - } - if (Std.isOfType(o, IHxObject)) { - return untyped (o : IHxObject).__hx_getField(field, false, false, true); - } - if (Runtime.slowHasField(o, "get_" + field)) { - return Runtime.slowCallField(o, "get_" + field, null); - } - return Runtime.slowGetField(o, field, false); - } - - public static function setProperty(o:Dynamic, field:String, value:Dynamic):Void { - if (Std.isOfType(o, IHxObject)) { - untyped (o : IHxObject).__hx_setField(field, value, true); - } else if (Runtime.slowHasField(o, "set_" + field)) { - Runtime.slowCallField(o, "set_" + field, java.NativeArray.make(value)); - } else { - Runtime.slowSetField(o, field, value); - } - } - - public static function callMethod(o:Dynamic, func:haxe.Constraints.Function, args:Array):Dynamic { - var args = java.Lib.nativeArray(args, true); - return untyped (func : Function).__hx_invokeDynamic(args); - } - - @:keep - public static function fields(o:Dynamic):Array { - if (Std.isOfType(o, IHxObject)) { - var ret:Array = []; - untyped (o : IHxObject).__hx_getFields(ret); - return ret; - } else if (Std.isOfType(o, java.lang.Class)) { - return Type.getClassFields(cast o); - } else { - return []; - } - } - - public static function isFunction(f:Dynamic):Bool { - return Std.isOfType(f, Function); - } - - public static function compare(a:T, b:T):Int { - return Runtime.compare(a, b); - } - - @:access(java.internal.Closure) - public static function compareMethods(f1:Dynamic, f2:Dynamic):Bool { - if (f1 == f2) { - return true; - } - if (Std.isOfType(f1, Closure) && Std.isOfType(f2, Closure)) { - var f1c:Closure = cast f1; - var f2c:Closure = cast f2; - return Runtime.refEq(f1c.obj, f2c.obj) && f1c.field == f2c.field; - } - return false; - } - - public static function isObject(v:Dynamic):Bool { - return v != null - && !(Std.isOfType(v, HxEnum) - || Std.isOfType(v, Function) - || Std.isOfType(v, java.lang.Enum) - || Std.isOfType(v, java.lang.Number) - || Std.isOfType(v, java.lang.Boolean.BooleanClass)); - } - - public static function isEnumValue(v:Dynamic):Bool { - return v != null && (Std.isOfType(v, HxEnum) || Std.isOfType(v, java.lang.Enum)); - } - - public static function deleteField(o:Dynamic, field:String):Bool { - return (Std.isOfType(o, DynamicObject) && (o : DynamicObject).__hx_deleteField(field)); - } - - public static function copy(o:Null):Null { - if (o == null) - return null; - var o2:Dynamic = {}; - for (f in Reflect.fields(o)) - Reflect.setField(o2, f, Reflect.field(o, f)); - return cast o2; - } - - @:overload(function(f:Array->Void):Dynamic {}) - public static function makeVarArgs(f:Array->Dynamic):Dynamic { - return new VarArgsFunction(f); - } -} diff --git a/std/java/_std/Std.hx b/std/java/_std/Std.hx deleted file mode 100644 index 1f939c88714..00000000000 --- a/std/java/_std/Std.hx +++ /dev/null @@ -1,199 +0,0 @@ -/* - * 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. - */ - -import java.Boot; -import java.Lib; - -using StringTools; - -@:coreApi @:nativeGen class Std { - @:deprecated('Std.is is deprecated. Use Std.isOfType instead.') - public static inline function is(v:Dynamic, t:Dynamic):Bool { - return isOfType(v, t); - } - - public static function isOfType(v:Dynamic, t:Dynamic):Bool { - if (v == null) - return false; - if (t == null) - return false; - var clt:java.lang.Class = cast t; - if (clt == null) - return false; - var name:String = clt.getName(); - - switch (name) { - case "double", "java.lang.Double": - return untyped __java__('haxe.lang.Runtime.isDouble(v)'); - case "int", "java.lang.Integer": - return untyped __java__('haxe.lang.Runtime.isInt(v)'); - case "boolean", "java.lang.Boolean": - return untyped __java__('v instanceof java.lang.Boolean'); - case "java.lang.Object": - return true; - } - - var clv:java.lang.Class = untyped __java__('v.getClass()'); - - return clt.isAssignableFrom(clv); - } - - public static function string(s:Dynamic):String { - return cast(s, String) + ""; - } - - public static function int(x:Float):Int { - return cast x; - } - - static inline function isSpaceChar(code:Int):Bool - return (code > 8 && code < 14) || code == 32; - - static inline function isHexPrefix(cur:Int, next:Int):Bool - return cur == '0'.code && (next == 'x'.code || next == 'X'.code); - - static inline function isDecimalDigit(code:Int):Bool - return '0'.code <= code && code <= '9'.code; - - static inline function isHexadecimalDigit(code:Int):Bool - return isDecimalDigit(code) || ('a'.code <= code && code <= 'f'.code) || ('A'.code <= code && code <= 'F'.code); - - public static function parseInt(x:String):Null { - if (x == null) - return null; - - final len = x.length; - var index = 0; - - inline function hasIndex(index:Int) - return index < len; - - // skip whitespace - while (hasIndex(index)) { - if (!isSpaceChar(x.unsafeCodeAt(index))) - break; - ++index; - } - - // handle sign - final isNegative = hasIndex(index) && { - final sign = x.unsafeCodeAt(index); - if (sign == '-'.code || sign == '+'.code) { - ++index; - } - sign == '-'.code; - } - - // handle base - final isHexadecimal = hasIndex(index + 1) && isHexPrefix(x.unsafeCodeAt(index), x.unsafeCodeAt(index + 1)); - if (isHexadecimal) - index += 2; // skip prefix - - // handle digits - final firstInvalidIndex = { - var cur = index; - if (isHexadecimal) { - while (hasIndex(cur)) { - if (!isHexadecimalDigit(x.unsafeCodeAt(cur))) - break; - ++cur; - } - } else { - while (hasIndex(cur)) { - if (!isDecimalDigit(x.unsafeCodeAt(cur))) - break; - ++cur; - } - } - cur; - } - - // no valid digits - if (index == firstInvalidIndex) - return null; - - final result = java.lang.Integer.parseInt(x.substring(index, firstInvalidIndex), if (isHexadecimal) 16 else 10); - return if (isNegative) -result else result; - } - - public static function parseFloat(x:String):Float { - if (x == null) - return Math.NaN; - x = StringTools.ltrim(x); - var found = false, - hasDot = false, - hasSign = false, - hasE = false, - hasESign = false, - hasEData = false; - var i = -1; - inline function getch(i:Int):Int - return cast(untyped x._charAt(i) : java.StdTypes.Char16); - - while (++i < x.length) { - var chr = getch(i); - if (chr >= '0'.code && chr <= '9'.code) { - if (hasE) { - hasEData = true; - } - found = true; - } else - switch (chr) { - case 'e'.code | 'E'.code if (!hasE): - hasE = true; - case '.'.code if (!hasDot): - hasDot = true; - case '-'.code, '+'.code if (!found && !hasSign): - hasSign = true; - case '-'.code | '+'.code if (found && !hasESign && hasE && !hasEData): - hasESign = true; - case _: - break; - } - } - if (hasE && !hasEData) { - i--; - if (hasESign) - i--; - } - - if (i != x.length) { - x = x.substr(0, i); - } - return try java.lang.Double.DoubleClass.parseDouble(x) catch (e:Dynamic) Math.NaN; - } - - inline public static function downcast(value:T, c:Class):S { - return Std.isOfType(value, c) ? cast value : null; - } - - @:deprecated('Std.instance() is deprecated. Use Std.downcast() instead.') - inline public static function instance(value:T, c:Class):S { - return downcast(value, c); - } - - public static function random(x:Int):Int { - if (x <= 0) - return 0; - return Std.int(Math.random() * x); - } -} diff --git a/std/java/_std/String.hx b/std/java/_std/String.hx deleted file mode 100644 index 1cf2eb0b6f6..00000000000 --- a/std/java/_std/String.hx +++ /dev/null @@ -1,58 +0,0 @@ -/* - * 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. - */ -@:coreApi extern class String implements java.lang.CharSequence { - var length(default, null):Int; - - @:overload(function(b:haxe.io.BytesData, offset:Int, length:Int, charsetName:String):Void {}) - @:overload(function(b:haxe.io.BytesData, offset:Int, length:Int):Void {}) - @:overload(function(b:java.NativeArray):Void {}) - function new(string:String):Void; - - function toUpperCase():String; - - function toLowerCase():String; - - function charAt(index:Int):String; - - function charCodeAt(index:Int):Null; - - function indexOf(str:String, ?startIndex:Int):Int; - - function lastIndexOf(str:String, ?startIndex:Int):Int; - - function split(delimiter:String):Array; - - function substr(pos:Int, ?len:Int):String; - - function substring(startIndex:Int, ?endIndex:Int):String; - - function toString():String; - - private function compareTo(anotherString:String):Int; - - private function codePointAt(idx:Int):Int; - - @:overload(function():haxe.io.BytesData {}) - private function getBytes(encoding:String):haxe.io.BytesData; - - static function fromCharCode(code:Int):String; -} diff --git a/std/java/_std/StringBuf.hx b/std/java/_std/StringBuf.hx deleted file mode 100644 index 731fbb74ac0..00000000000 --- a/std/java/_std/StringBuf.hx +++ /dev/null @@ -1,59 +0,0 @@ -/* - * 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. - */ -@:coreApi -class StringBuf { - private var b:java.lang.StringBuilder; - - public var length(get, never):Int; - - public function new():Void { - b = new java.lang.StringBuilder(); - } - - inline function get_length():Int { - return b.length(); - } - - public function add(x:T):Void { - if (Std.isOfType(x, Int)) { - var x:Int = cast x; - var xd:Dynamic = x; - b.append(xd); - } else { - b.append(x); - } - } - - public function addSub(s:String, pos:Int, ?len:Int):Void { - var l:Int = (len == null) ? s.length - pos : len; - b.append(s, pos, pos + l); - } - - public function addChar(c:Int):Void - untyped { - b.appendCodePoint(c); - } - - public function toString():String { - return b.toString(); - } -} diff --git a/std/java/_std/Type.hx b/std/java/_std/Type.hx deleted file mode 100644 index a07ffd6562a..00000000000 --- a/std/java/_std/Type.hx +++ /dev/null @@ -1,370 +0,0 @@ -/* - * 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. - */ - -import java.internal.HxObject; - -using StringTools; - -enum ValueType { - TNull; - TInt; - TFloat; - TBool; - TObject; - TFunction; - TClass(c:Class); - TEnum(e:Enum); - TUnknown; -} - -@:coreApi class Type { - public static function getClass(o:T):Null> { - if (o == null || Std.isOfType(o, DynamicObject) || Std.isOfType(o, java.lang.Class)) { - return null; - } - return cast java.Lib.getNativeType(o); - } - - public static function getEnum(o:EnumValue):Enum { - if (Std.isOfType(o, java.lang.Enum) || Std.isOfType(o, HxEnum)) { - return untyped o.getClass(); - } - return null; - } - - public static function getSuperClass(c:Class):Class { - var c = java.Lib.toNativeType(c); - var cl:java.lang.Class = c == null ? null : untyped c.getSuperclass(); - if (cl != null && cl.getName() != "haxe.lang.HxObject" && cl.getName() != "java.lang.Object") { - return cast cl; - } - return null; - } - - public static function getClassName(c:Class):String { - var c:java.lang.Class = cast c; - var name:String = c.getName(); - if (name.startsWith("haxe.root.")) - return name.substr(10); - if (name.startsWith("java.lang")) - name = name.substr(10); - - return switch (name) { - case "int", "Integer": "Int"; - case "double", "Double": "Float"; - case "Object": "Dynamic"; - default: name; - } - } - - public static function getEnumName(e:Enum):String { - var c:java.lang.Class = cast e; - var ret:String = c.getName(); - if (ret.startsWith("haxe.root.")) - return ret.substr(10); - - return ret; - } - - public static function resolveClass(name:String):Class { - try { - if (name.indexOf(".") == -1) { - name = "haxe.root." + name; - } - return cast java.lang.Class.forName(name); - } catch (e:java.lang.ClassNotFoundException) { - return untyped switch (name) { - case "haxe.root.Int": Int; - case "haxe.root.Float": Float; - case "haxe.root.String": String; - case "haxe.root.Math": java.lang.Math; - case "haxe.root.Class": java.lang.Class; - case "haxe.root.Dynamic": java.lang.Object; - case _: null; - } - } - } - - @:functionCode(' - if ("Bool".equals(name)) return boolean.class; - Class r = resolveClass(name); - if (r != null && (r.getSuperclass() == java.lang.Enum.class || haxe.lang.Enum.class.isAssignableFrom(r))) - return r; - return null; - ') - public static function resolveEnum(name:String):Enum - untyped { - if (name == "Bool") - return Bool; - return resolveClass(name); - } - - public static function createInstance(cl:Class, args:Array):T { - var nargs = args.length, - callArguments = new java.NativeArray(nargs); - - var ctors = java.Lib.toNativeType(cl).getConstructors(), - totalCtors = ctors.length, - validCtors = 0; - - for (i in 0...totalCtors) { - var ctor = ctors[i]; - var ptypes = ctor.getParameterTypes(); - if (ptypes.length != nargs && !ctor.isVarArgs()) { - continue; - } - - var argNum = -1, valid = true; - for (arg in args) { - argNum++; - var expectedType = argNum < ptypes.length ? ptypes[argNum] : ptypes[ptypes.length - 1]; // varags - var isDynamic = Std.isOfType(arg, DynamicObject) && expectedType.isAssignableFrom(java.Lib.getNativeType(arg)); - var argType = Type.getClass(arg); - - if (arg == null || isDynamic || (argType != null && expectedType.isAssignableFrom(java.Lib.toNativeType(argType)))) { - callArguments[argNum] = arg; - } else if(expectedType.getName() == 'boolean' && (cast argType:java.lang.Class).getName() == 'java.lang.Boolean') { - callArguments[argNum] = (cast arg : java.lang.Boolean).booleanValue(); - } else if (Std.isOfType(arg, java.lang.Number)) { - var name = expectedType.getName(); - switch (name) { - case 'double' | 'java.lang.Double': - callArguments[argNum] = (cast arg : java.lang.Number).doubleValue(); - case 'int' | 'java.lang.Integer': - callArguments[argNum] = (cast arg : java.lang.Number).intValue(); - case 'float' | 'java.lang.Float': - callArguments[argNum] = (cast arg : java.lang.Number).floatValue(); - case 'byte' | 'java.lang.Byte': - callArguments[argNum] = (cast arg : java.lang.Number).byteValue(); - case 'short' | 'java.lang.Short': - callArguments[argNum] = (cast arg : java.lang.Number).shortValue(); - case _: - valid = false; - break; - } - } else { - valid = false; - break; - } - } - if (!valid) { - continue; - } - - // the current constructor was found and it is valid - call it - ctor.setAccessible(true); - return cast ctor.newInstance(callArguments); - } - - throw 'Could not find any constructor that matches the provided arguments for class $cl'; - } - - // cache empty constructor arguments so we don't allocate it on each createEmptyInstance call - @:protected @:readOnly static var __createEmptyInstance_EMPTY_TYPES = java.Lib.toNativeEnum(java.internal.Runtime.EmptyObject); - @:protected @:readOnly static var __createEmptyInstance_EMPTY_ARGS = java.internal.Runtime.EmptyObject.EMPTY; - - public static function createEmptyInstance(cl:Class):T { - var t = java.Lib.toNativeType(cl); - try { - var ctor = t.getConstructor(__createEmptyInstance_EMPTY_TYPES); - return ctor.newInstance(__createEmptyInstance_EMPTY_ARGS); - } catch (_:java.lang.NoSuchMethodException) { - return t.newInstance(); - } - } - - public static function createEnum(e:Enum, constr:String, ?params:Array):T { - if (params == null || params.length == 0) { - var ret:Dynamic = java.internal.Runtime.slowGetField(e, constr, true); - if (Std.isOfType(ret, java.internal.Function)) { - throw "Constructor " + constr + " needs parameters"; - } - return ret; - } else { - var params = java.Lib.nativeArray(params, true); - return java.internal.Runtime.slowCallField(e, constr, params); - } - } - - public static function createEnumIndex(e:Enum, index:Int, ?params:Array):T { - var constr = getEnumConstructs(e); - return createEnum(e, constr[index], params); - } - - @:functionCode(' - if (c == java.lang.String.class) - { - return haxe.lang.StringRefl.fields; - } - - Array ret = new Array(); - for (java.lang.reflect.Field f : c.getFields()) - { - java.lang.String fname = f.getName(); - if (!java.lang.reflect.Modifier.isStatic(f.getModifiers()) && !fname.startsWith("__hx_")) - ret.push(fname); - } - - for (java.lang.reflect.Method m : c.getMethods()) - { - if (m.getDeclaringClass() == java.lang.Object.class) - continue; - java.lang.String mname = m.getName(); - if (!java.lang.reflect.Modifier.isStatic(m.getModifiers()) && !mname.startsWith("__hx_")) - ret.push(mname); - } - - return ret; - ') - public static function getInstanceFields(c:Class):Array { - return null; - } - - @:functionCode(' - Array ret = new Array(); - if (c == java.lang.String.class) - { - ret.push("fromCharCode"); - return ret; - } - - for (java.lang.reflect.Field f : c.getDeclaredFields()) - { - java.lang.String fname = f.getName(); - if (java.lang.reflect.Modifier.isStatic(f.getModifiers()) && !fname.startsWith("__hx_")) - ret.push(fname); - } - - for (java.lang.reflect.Method m : c.getDeclaredMethods()) - { - if (m.getDeclaringClass() == java.lang.Object.class) - continue; - java.lang.String mname = m.getName(); - if (java.lang.reflect.Modifier.isStatic(m.getModifiers()) && !mname.startsWith("__hx_")) - ret.push(mname); - } - - return ret; - ') - public static function getClassFields(c:Class):Array { - return null; - } - - public static function getEnumConstructs(e:Enum):Array { - if (Reflect.hasField(e, "__hx_constructs")) { - var ret:Array = java.Lib.array(untyped e.__hx_constructs); - return ret.copy(); - } - var vals:java.NativeArray> = untyped e.values(), - ret = []; - for (i in 0...vals.length) - ret[i] = vals[i].name(); - return ret; - } - - @:functionCode(' - if (v == null) return ValueType.TNull; - - if (v instanceof haxe.lang.IHxObject) { - haxe.lang.IHxObject vobj = (haxe.lang.IHxObject) v; - java.lang.Class cl = vobj.getClass(); - if (v instanceof haxe.lang.DynamicObject) - return ValueType.TObject; - else - return ValueType.TClass(cl); - } else if (v instanceof java.lang.Number) { - java.lang.Number n = (java.lang.Number) v; - if (n.intValue() == n.doubleValue()) - return ValueType.TInt; - else - return ValueType.TFloat; - } else if (v instanceof haxe.lang.Function) { - return ValueType.TFunction; - } else if (v instanceof java.lang.Enum || v instanceof haxe.lang.Enum) { - return ValueType.TEnum(v.getClass()); - } else if (v instanceof java.lang.Boolean) { - return ValueType.TBool; - } else if (v instanceof java.lang.Class) { - return ValueType.TObject; - } else { - return ValueType.TClass(v.getClass()); - } - ') - public static function typeof(v:Dynamic):ValueType - untyped { - return null; - } - - @:functionCode(' - if (a instanceof haxe.lang.Enum) - return a.equals(b); - else - return haxe.lang.Runtime.eq(a, b); - ') - public static function enumEq(a:T, b:T):Bool - untyped { - return a == b; - } - - @:functionCode(' - if (e instanceof java.lang.Enum) - return ((java.lang.Enum) e).name(); - else - return ((haxe.lang.Enum) e).getTag(); - ') - public static function enumConstructor(e:EnumValue):String - untyped { - return null; - } - - @:functionCode(' - return ( e instanceof java.lang.Enum ) ? new haxe.root.Array() : ((haxe.lang.Enum) e).getParams(); - ') - public static function enumParameters(e:EnumValue):Array - untyped { - return null; - } - - @:ifFeature("has_enum") - @:functionCode(' - if (e instanceof java.lang.Enum) - return ((java.lang.Enum) e).ordinal(); - else - return ((haxe.lang.Enum) e).index; - ') - public static function enumIndex(e:EnumValue):Int - untyped { - return e.index; - } - - public static function allEnums(e:Enum):Array { - var ctors = getEnumConstructs(e); - var ret = []; - for (ctor in ctors) { - var v = Reflect.field(e, ctor); - if (Std.isOfType(v, e)) - ret.push(v); - } - - return ret; - } -} diff --git a/std/java/_std/haxe/Rest.hx b/std/java/_std/haxe/Rest.hx deleted file mode 100644 index 1747861cc05..00000000000 --- a/std/java/_std/haxe/Rest.hx +++ /dev/null @@ -1,118 +0,0 @@ -package haxe; - -import haxe.iterators.RestIterator; -import haxe.iterators.RestKeyValueIterator; -import java.NativeArray; -import java.StdTypes; -import java.lang.Object; -import java.lang.System; -import java.util.Arrays; - -private typedef NativeRest = NativeArray; - -@:coreApi -abstract Rest(NativeRest) { - public var length(get, never):Int; - - inline function get_length():Int - return this.length; - - @:from extern inline static public function of(array:Array):Rest { - var result = createNative(array.length); - var src:NativeArray = cast @:privateAccess array.__a; - for (i in 0...result.length) - result[i] = cast src[i]; - return new Rest(result); - } - - @:noDoc - @:generic - static function ofNativePrimitive(result:NativeRest, collection:NativeArray):Rest { - for (i in 0...collection.length) - result[i] = cast collection[i]; - return new Rest(cast result); - } - - @:noDoc - @:from static function ofNativeInt(collection:NativeArray):Rest - return ofNativePrimitive(new NativeRest(collection.length), collection); - - @:noDoc - @:from static function ofNativeFloat(collection:NativeArray):Rest - return ofNativePrimitive(new NativeRest(collection.length), collection); - - @:noDoc - @:from static function ofNativeBool(collection:NativeArray):Rest - return ofNativePrimitive(new NativeRest(collection.length), collection); - - @:noDoc - @:from static function ofNativeInt8(collection:NativeArray):Rest - return ofNativePrimitive(new NativeRest(collection.length), collection); - - @:noDoc - @:from static function ofNativeInt16(collection:NativeArray):Rest - return ofNativePrimitive(new NativeRest(collection.length), collection); - - @:noDoc - @:from static function ofNativeChar16(collection:NativeArray):Rest - return ofNativePrimitive(new NativeRest(collection.length), collection); - - @:noDoc - @:from static function ofNativeHaxeInt64(collection:NativeArray):Rest - return ofNativePrimitive(new NativeRest(collection.length), collection); - - @:noDoc - @:from static function ofNativeInt64(collection:NativeArray):Rest - return ofNativePrimitive(new NativeRest(collection.length), collection); - - @:noDoc - @:from static function ofNative(collection:NativeArray):Rest { - return new Rest(collection); - } - - inline function new(a:NativeRest):Void - this = a; - - /** - * Implemented in genjvm (to auto-box primitive types) and genjava - */ - static function createNative(length:Int):NativeRest - return new NativeRest(length); - - @:arrayAccess inline function get(index:Int):T - return this[index]; - - @:to public function toArray():Array { - return [for (i in 0...this.length) this[i]]; - } - - public inline function iterator():RestIterator - return new RestIterator(this); - - public inline function keyValueIterator():RestKeyValueIterator - return new RestKeyValueIterator(this); - - extern inline public function append(item:T):Rest { - return _append(createNative(this.length + 1), item); - } - - function _append(result:NativeRest, item:T):Rest { - System.arraycopy(this, 0, result, 0, this.length); - result[this.length] = cast item; - return new Rest(result); - } - - extern inline public function prepend(item:T):Rest { - return _prepend(createNative(this.length + 1), item); - } - - function _prepend(result:NativeRest, item:T):Rest { - System.arraycopy(this, 0, result, 1, this.length); - result[0] = cast item; - return new Rest(result); - } - - public function toString():String { - return toArray().toString(); - } -} diff --git a/std/java/_std/haxe/ds/StringMap.hx b/std/java/_std/haxe/ds/StringMap.hx deleted file mode 100644 index 307b15178e6..00000000000 --- a/std/java/_std/haxe/ds/StringMap.hx +++ /dev/null @@ -1,533 +0,0 @@ -/* - * 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; - -import java.NativeArray; - -@:coreApi class StringMap implements haxe.Constraints.IMap { - extern private static inline var HASH_UPPER = 0.77; - extern private static inline var FLAG_EMPTY = 0; - extern private static inline var FLAG_DEL = 1; - - /** - * This is the most important structure here and the reason why it's so fast. - * It's an array of all the hashes contained in the table. These hashes cannot be 0 nor 1, - * which stand for "empty" and "deleted" states. - * - * The lookup algorithm will keep looking until a 0 or the key wanted is found; - * The insertion algorithm will do the same but will also break when FLAG_DEL is found; - */ - private var hashes:NativeArray; - - private var _keys:NativeArray; - private var vals:NativeArray; - - private var nBuckets:Int; - private var size:Int; - private var nOccupied:Int; - private var upperBound:Int; - - #if !no_map_cache - private var cachedKey:String; - private var cachedIndex:Int; - #end - - #if DEBUG_HASHTBL - private var totalProbes:Int; - private var probeTimes:Int; - private var sameHash:Int; - private var maxProbe:Int; - #end - - public function new():Void { - #if !no_map_cache - cachedIndex = -1; - #end - } - - public function set(key:String, value:T):Void { - var x:Int, k:Int; - if (nOccupied >= upperBound) { - if (nBuckets > (size << 1)) { - resize(nBuckets - 1); // clear "deleted" elements - } else { - resize(nBuckets + 2); - } - } - - var hashes = hashes, keys = _keys, hashes = hashes; - { - var mask = (nBuckets == 0) ? 0 : nBuckets - 1; - var site = x = nBuckets; - k = hash(key); - var i = k & mask, nProbes = 0; - - var delKey = -1; - // to speed things up, don't loop if the first bucket is already free - if (isEmpty(hashes[i])) { - x = i; - } else { - var last = i, flag; - while (!(isEmpty(flag = hashes[i]) || (flag == k && _keys[i] == key))) { - if (isDel(flag) && delKey == -1) { - delKey = i; - } - i = (i + ++nProbes) & mask; - #if DEBUG_HASHTBL - probeTimes++; - if (i == last) - throw "assert"; - #end - } - - if (isEmpty(flag) && delKey != -1) { - x = delKey; - } else { - x = i; - } - } - - #if DEBUG_HASHTBL - if (nProbes > maxProbe) - maxProbe = nProbes; - totalProbes++; - #end - } - - var flag = hashes[x]; - if (isEmpty(flag)) { - keys[x] = key; - vals[x] = value; - hashes[x] = k; - size++; - nOccupied++; - } else if (isDel(flag)) { - keys[x] = key; - vals[x] = value; - hashes[x] = k; - size++; - } else { - assert(_keys[x] == key); - vals[x] = value; - } - - #if !no_map_cache - cachedIndex = x; - cachedKey = key; - #end - } - - private final function lookup(key:String):Int { - if (nBuckets != 0) { - var hashes = hashes, keys = _keys; - - var mask = nBuckets - 1, hash = hash(key), k = hash, nProbes = 0; - var i = k & mask; - var last = i, flag; - // if we hit an empty bucket, it means we're done - while (!isEmpty(flag = hashes[i]) && (isDel(flag) || flag != k || keys[i] != key)) { - i = (i + ++nProbes) & mask; - #if DEBUG_HASHTBL - probeTimes++; - if (i == last) - throw "assert"; - #end - } - - #if DEBUG_HASHTBL - if (nProbes > maxProbe) - maxProbe = nProbes; - totalProbes++; - #end - return isEither(flag) ? -1 : i; - } - - return -1; - } - - @:private final function resize(newNBuckets:Int):Void { - // This function uses 0.25*n_bucktes bytes of working space instead of [sizeof(key_t+val_t)+.25]*n_buckets. - var newHash = null; - var j = 1; - { - newNBuckets = roundUp(newNBuckets); - if (newNBuckets < 4) - newNBuckets = 4; - if (size >= (newNBuckets * HASH_UPPER + 0.5)) - /* requested size is too small */ { - j = 0; - } else { /* hash table size to be changed (shrink or expand); rehash */ - var nfSize = newNBuckets; - newHash = new NativeArray(nfSize); - if (nBuckets < newNBuckets) // expand - { - var k = new NativeArray(newNBuckets); - if (_keys != null) - arrayCopy(_keys, 0, k, 0, nBuckets); - _keys = k; - - var v = new NativeArray(newNBuckets); - if (vals != null) - arrayCopy(vals, 0, v, 0, nBuckets); - vals = v; - } // otherwise shrink - } - } - - if (j != 0) { // rehashing is required - // resetting cache - #if !no_map_cache - cachedKey = null; - cachedIndex = -1; - #end - - j = -1; - var nBuckets = nBuckets, - _keys = _keys, - vals = vals, - hashes = hashes; - - var newMask = newNBuckets - 1; - while (++j < nBuckets) { - var k; - if (!isEither(k = hashes[j])) { - var key = _keys[j]; - var val = vals[j]; - - _keys[j] = null; - vals[j] = cast null; - hashes[j] = FLAG_DEL; - while (true) - /* kick-out process; sort of like in Cuckoo hashing */ { - var nProbes = 0; - var i = k & newMask; - - while (!isEmpty(newHash[i])) { - i = (i + ++nProbes) & newMask; - } - - newHash[i] = k; - - if (i < nBuckets && !isEither(k = hashes[i])) - /* kick out the existing element */ { - { - var tmp = _keys[i]; - _keys[i] = key; - key = tmp; - } { - var tmp = vals[i]; - vals[i] = val; - val = tmp; - } - - hashes[i] = FLAG_DEL; /* mark it as deleted in the old hash table */ - } else { /* write the element and jump out of the loop */ - _keys[i] = key; - vals[i] = val; - break; - } - } - } - } - - if (nBuckets > newNBuckets) - /* shrink the hash table */ { - { - var k = new NativeArray(newNBuckets); - arrayCopy(_keys, 0, k, 0, newNBuckets); - this._keys = k; - } { - var v = new NativeArray(newNBuckets); - arrayCopy(vals, 0, v, 0, newNBuckets); - this.vals = v; - } - } - - this.hashes = newHash; - this.nBuckets = newNBuckets; - this.nOccupied = size; - this.upperBound = Std.int(newNBuckets * HASH_UPPER + .5); - } - } - - public function get(key:String):Null { - var idx = -1; - #if !no_map_cache - if (cachedKey == key && ((idx = cachedIndex) != -1)) { - return vals[idx]; - } - #end - idx = lookup(key); - if (idx != -1) { - #if !no_map_cache - cachedKey = key; - cachedIndex = idx; - #end - return vals[idx]; - } - - return null; - } - - private function getDefault(key:String, def:T):T { - var idx = -1; - #if !no_map_cache - if (cachedKey == key && ((idx = cachedIndex) != -1)) { - return vals[idx]; - } - #end - - idx = lookup(key); - if (idx != -1) { - #if !no_map_cache - cachedKey = key; - cachedIndex = idx; - #end - - return vals[idx]; - } - - return def; - } - - public function exists(key:String):Bool { - var idx = -1; - #if !no_map_cache - if (cachedKey == key && ((idx = cachedIndex) != -1)) { - return true; - } - #end - - idx = lookup(key); - if (idx != -1) { - #if !no_map_cache - cachedKey = key; - cachedIndex = idx; - #end - return true; - } - - return false; - } - - public function remove(key:String):Bool { - var idx = -1; - #if !no_map_cache - if (!(cachedKey == key && ((idx = cachedIndex) != -1))) - #end - { - idx = lookup(key); - } - - if (idx == -1) { - return false; - } else { - #if !no_map_cache - if (cachedKey == key) { - cachedIndex = -1; - } - #end - hashes[idx] = FLAG_DEL; - _keys[idx] = null; - vals[idx] = null; - --size; - - return true; - } - } - - public inline function keys():Iterator { - return new StringMapKeyIterator(this); - } - - @:runtime public inline function keyValueIterator():KeyValueIterator { - return new haxe.iterators.MapKeyValueIterator(this); - } - - public inline function iterator():Iterator { - return new StringMapValueIterator(this); - } - - public function copy():StringMap { - var copied = new StringMap(); - for (key in keys()) - copied.set(key, get(key)); - return copied; - } - - public function toString():String { - var s = new StringBuf(); - s.add("["); - var it = keys(); - for (i in it) { - s.add(i); - s.add(" => "); - s.add(Std.string(get(i))); - if (it.hasNext()) - s.add(", "); - } - s.add("]"); - return s.toString(); - } - - public function clear():Void { - hashes = null; - _keys = null; - vals = null; - nBuckets = 0; - size = 0; - nOccupied = 0; - upperBound = 0; - #if !no_map_cache - cachedKey = null; - cachedIndex = -1; - #end - #if DEBUG_HASHTBL - totalProbes = 0; - probeTimes = 0; - sameHash = 0; - maxProbe = 0; - #end - } - - extern private static inline function roundUp(x:Int):Int { - --x; - x |= (x) >>> 1; - x |= (x) >>> 2; - x |= (x) >>> 4; - x |= (x) >>> 8; - x |= (x) >>> 16; - return ++x; - } - - extern private static inline function getInc(k:Int, mask:Int):Int // return 1 for linear probing - return (((k) >> 3 ^ (k) << 3) | 1) & (mask); - - extern private static inline function isEither(v:HashType):Bool - return (v & 0xFFFFFFFE) == 0; - - extern private static inline function isEmpty(v:HashType):Bool - return v == FLAG_EMPTY; - - extern private static inline function isDel(v:HashType):Bool - return v == FLAG_DEL; - - // guarantee: Whatever this function is, it will never return 0 nor 1 - extern private static inline function hash(s:String):HashType { - var k:Int = (cast s : java.NativeString).hashCode(); - // k *= 357913941; - // k ^= k << 24; - // k += ~357913941; - // k ^= k >> 31; - // k ^= k << 31; - - k = (k + 0x7ed55d16) + (k << 12); - k = (k ^ 0xc761c23c) ^ (k >> 19); - k = (k + 0x165667b1) + (k << 5); - k = (k + 0xd3a2646c) ^ (k << 9); - k = (k + 0xfd7046c5) + (k << 3); - k = (k ^ 0xb55a4f09) ^ (k >> 16); - - var ret = k; - if (isEither(ret)) { - if (ret == 0) - ret = 2; - else - ret = 0xFFFFFFFF; - } - - return ret; - } - - extern private static inline function arrayCopy(sourceArray:Dynamic, sourceIndex:Int, destinationArray:Dynamic, destinationIndex:Int, length:Int):Void - java.lang.System.arraycopy(sourceArray, sourceIndex, destinationArray, destinationIndex, length); - - extern private static inline function assert(x:Bool):Void { - #if DEBUG_HASHTBL - if (!x) - throw "assert failed"; - #end - } -} - -private typedef HashType = Int; - -@:access(haxe.ds.StringMap) -private final class StringMapKeyIterator { - var m:StringMap; - var i:Int; - var len:Int; - - public function new(m:StringMap) { - this.m = m; - this.i = 0; - this.len = m.nBuckets; - } - - public function hasNext():Bool { - for (j in i...len) { - if (!StringMap.isEither(m.hashes[j])) { - i = j; - return true; - } - } - return false; - } - - public function next():String { - var ret = m._keys[i]; - #if !no_map_cache - m.cachedIndex = i; - m.cachedKey = ret; - #end - i++; - return ret; - } -} - -@:access(haxe.ds.StringMap) -private final class StringMapValueIterator { - var m:StringMap; - var i:Int; - var len:Int; - - public function new(m:StringMap) { - this.m = m; - this.i = 0; - this.len = m.nBuckets; - } - - public function hasNext():Bool { - for (j in i...len) { - if (!StringMap.isEither(m.hashes[j])) { - i = j; - return true; - } - } - return false; - } - - public inline function next():T { - return m.vals[i++]; - } -} diff --git a/std/java/_std/sys/thread/Lock.hx b/std/java/_std/sys/thread/Lock.hx deleted file mode 100644 index fdba7e75853..00000000000 --- a/std/java/_std/sys/thread/Lock.hx +++ /dev/null @@ -1,78 +0,0 @@ -/* - * 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 sys.thread; - -import java.Lib; -import java.lang.System; - -using haxe.Int64; - -@:coreApi -@:native('haxe.java.vm.Lock') class Lock { - @:private @:volatile var releasedCount = 0; - - public function new() {} - - public function wait(?timeout:Float):Bool { - var ret = false; - java.Lib.lock(this, { - if (--releasedCount < 0) { - if (timeout == null) { - // since .notify() is asynchronous, this `while` is needed - // because there is a very remote possibility of release() awaking a thread, - // but before it releases, another thread calls wait - and since the release count - // is still positive, it will get the lock. - while (releasedCount < 0) { - try { - (cast this : java.lang.Object).wait(); - } catch (e:java.lang.InterruptedException) {} - } - } else { - var timeout:haxe.Int64 = cast timeout * 1000; - var cur = System.currentTimeMillis(), - max = cur.add(timeout); - // see above comment about this while loop - while (releasedCount < 0 && cur.compare(max) < 0) { - try { - var t = max.sub(cur); - (cast this : java.lang.Object).wait(t); - cur = System.currentTimeMillis(); - } catch (e:java.lang.InterruptedException) {} - } - } - } - ret = this.releasedCount >= 0; - if (!ret) - this.releasedCount++; // timed out - }); - return ret; - } - - public function release():Void { - untyped __lock__(this, { - if (++releasedCount >= 0) { - untyped this.notify(); - } - }); - } -} diff --git a/std/java/internal/FieldLookup.hx b/std/java/internal/FieldLookup.hx deleted file mode 100644 index 04a4d8a3b24..00000000000 --- a/std/java/internal/FieldLookup.hx +++ /dev/null @@ -1,110 +0,0 @@ -/* - * 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 java.internal; - -import java.lang.System; - -@:native('haxe.lang.FieldLookup') -@:keep -@:static class FieldLookup { - @:functionCode(' - return s.hashCode(); - ') - public static function hash(s:String):Int { - return 0; - } - - public static function findHash(hash:String, hashs:java.NativeArray, length:Int):Int { - var min = 0; - var max = length; - - while (min < max) { - var mid = Std.int((max + min) / 2); // overflow safe - var classify = untyped hash.compareTo(hashs[mid]); - if (classify < 0) { - max = mid; - } else if (classify > 0) { - min = mid + 1; - } else { - return mid; - } - } - // if not found, return a negative value of where it should be inserted - return ~min; - } - - public static function removeString(a:java.NativeArray, length:Int, pos:Int) { - System.arraycopy(a, pos + 1, a, pos, length - pos - 1); - a[length - 1] = null; - } - - public static function removeFloat(a:java.NativeArray, length:Int, pos:Int) { - System.arraycopy(a, pos + 1, a, pos, length - pos - 1); - a[length - 1] = 0; - } - - public static function removeDynamic(a:java.NativeArray, length:Int, pos:Int) { - System.arraycopy(a, pos + 1, a, pos, length - pos - 1); - a[length - 1] = null; - } - - extern static inline function __insert(a:java.NativeArray, length:Int, pos:Int, x:T):java.NativeArray { - var capacity = a.length; - if (pos == length) { - if (capacity == length) { - var newarr = new NativeArray((length << 1) + 1); - System.arraycopy(a, 0, newarr, 0, a.length); - a = newarr; - } - } else if (pos == 0) { - if (capacity == length) { - var newarr = new NativeArray((length << 1) + 1); - System.arraycopy(a, 0, newarr, 1, length); - a = newarr; - } else { - System.arraycopy(a, 0, a, 1, length); - } - } else { - if (capacity == length) { - var newarr = new NativeArray((length << 1) + 1); - System.arraycopy(a, 0, newarr, 0, pos); - System.arraycopy(a, pos, newarr, pos + 1, length - pos); - a = newarr; - } else { - System.arraycopy(a, pos, a, pos + 1, length - pos); - System.arraycopy(a, 0, a, 0, pos); - } - } - a[pos] = x; - return a; - } - - public static function insertString(a:java.NativeArray, length:Int, pos:Int, x:String):java.NativeArray - return __insert(a, length, pos, x); - - public static function insertFloat(a:java.NativeArray, length:Int, pos:Int, x:Float):java.NativeArray - return __insert(a, length, pos, x); - - public static function insertDynamic(a:java.NativeArray, length:Int, pos:Int, x:Dynamic):java.NativeArray - return __insert(a, length, pos, x); -} diff --git a/std/java/internal/Function.hx b/std/java/internal/Function.hx deleted file mode 100644 index 495fd51cb4a..00000000000 --- a/std/java/internal/Function.hx +++ /dev/null @@ -1,82 +0,0 @@ -/* - * 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 java.internal; - -import java.internal.Runtime; - -/** - * These classes are automatically generated by the compiler. They are only - * here so there is an option for e.g. defining them as externs if you are compiling - * in modules (untested) - * - * @author waneck - */ -@:abstract @:nativeGen @:native("haxe.lang.Function") @:keep class Function { - function new(arity:Int, type:Int) {} -} - -@:nativeGen @:native("haxe.lang.VarArgsBase") @:keep private class VarArgsBase extends Function { - public function __hx_invokeDynamic(dynArgs:java.NativeArray):Dynamic { - throw "Abstract implementation"; - } -} - -@:nativeGen @:native('haxe.lang.VarArgsFunction') @:keep class VarArgsFunction extends VarArgsBase { - private var fun:Array->Dynamic; - - public function new(fun) { - super(-1, -1); - this.fun = fun; - } - - override public function __hx_invokeDynamic(dynArgs:java.NativeArray):Dynamic { - return fun(dynArgs == null ? [] : @:privateAccess Array.ofNative(dynArgs)); - } -} - -@:nativeGen @:native('haxe.lang.Closure') @:keep class Closure extends VarArgsBase { - private var obj:Dynamic; - private var field:String; - - public function new(obj:Dynamic, field) { - super(-1, -1); - this.obj = obj; - this.field = field; - } - - override public function __hx_invokeDynamic(dynArgs:java.NativeArray):Dynamic { - return Runtime.callField(obj, field, dynArgs); - } - - public function equals(obj:Dynamic):Bool { - if (obj == null) - return false; - - var c:Closure = cast obj; - return (c.obj == this.obj && c.field == this.field); - } - - public function hashCode():Int { - return obj.hashCode() ^ untyped field.hashCode(); - } -} diff --git a/std/java/internal/HxObject.hx b/std/java/internal/HxObject.hx deleted file mode 100644 index fdc7fd18791..00000000000 --- a/std/java/internal/HxObject.hx +++ /dev/null @@ -1,297 +0,0 @@ -/* - * 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 java.internal; - -import java.internal.IEquatable; -import haxe.ds.Vector; - -private typedef StdType = Type; - -@:native('haxe.lang.HxObject') -@:keep -private class HxObject implements IHxObject {} - -@:native('haxe.lang.IHxObject') -@:keep -interface IHxObject {} - -@:native('haxe.lang.DynamicObject') -@:keep -class DynamicObject extends HxObject { - @:skipReflection var __hx_fields:java.NativeArray; - @:skipReflection var __hx_dynamics:java.NativeArray; - - @:skipReflection var __hx_fields_f:java.NativeArray; - @:skipReflection var __hx_dynamics_f:java.NativeArray; - - @:skipReflection var __hx_length:Int; - @:skipReflection var __hx_length_f:Int; - - @:skipReflection static var __hx_toString_depth = 0; - - @:overload public function new() { - this.__hx_fields = new java.NativeArray(0); - this.__hx_dynamics = new java.NativeArray(0); - this.__hx_fields_f = new java.NativeArray(0); - this.__hx_dynamics_f = new java.NativeArray(0); - } - - @:overload public function new(fields:NativeArray, dynamics:NativeArray, fields_f:NativeArray, dynamics_f:NativeArray) { - this.__hx_fields = fields; - this.__hx_dynamics = dynamics; - this.__hx_fields_f = fields_f; - this.__hx_dynamics_f = dynamics_f; - this.__hx_length = fields.length; - this.__hx_length_f = fields_f.length; - } - - public function __hx_deleteField(field:String):Bool { - var res = FieldLookup.findHash(field, this.__hx_fields, this.__hx_length); - if (res >= 0) { - FieldLookup.removeString(this.__hx_fields, this.__hx_length, res); - FieldLookup.removeDynamic(this.__hx_dynamics, this.__hx_length, res); - this.__hx_length--; - return true; - } - var res = FieldLookup.findHash(field, this.__hx_fields_f, this.__hx_length_f); - if (res >= 0) { - FieldLookup.removeString(this.__hx_fields_f, this.__hx_length_f, res); - FieldLookup.removeFloat(this.__hx_dynamics_f, this.__hx_length_f, res); - this.__hx_length_f--; - return true; - } - return false; - } - - public function __hx_getField(field:String, throwErrors:Bool, isCheck:Bool, handleProperties:Bool):Dynamic { - var res = FieldLookup.findHash(field, this.__hx_fields, this.__hx_length); - if (res >= 0) { - return this.__hx_dynamics[res]; - } - res = FieldLookup.findHash(field, this.__hx_fields_f, this.__hx_length_f); - if (res >= 0) { - return this.__hx_dynamics_f[res]; - } - - return isCheck ? Runtime.undefined : null; - } - - public function __hx_setField(field:String, value:Dynamic, handleProperties:Bool):Dynamic { - var res = FieldLookup.findHash(field, this.__hx_fields, this.__hx_length); - if (res >= 0) { - return this.__hx_dynamics[res] = value; - } else { - var res = FieldLookup.findHash(field, this.__hx_fields_f, this.__hx_length_f); - if (res >= 0) { - if (Std.isOfType(value, Float)) { - return this.__hx_dynamics_f[res] = value; - } - - FieldLookup.removeString(this.__hx_fields_f, this.__hx_length_f, res); - FieldLookup.removeFloat(this.__hx_dynamics_f, this.__hx_length_f, res); - this.__hx_length_f--; - } - } - - this.__hx_fields = FieldLookup.insertString(this.__hx_fields, this.__hx_length, ~(res), field); - this.__hx_dynamics = FieldLookup.insertDynamic(this.__hx_dynamics, this.__hx_length, ~(res), value); - this.__hx_length++; - return value; - } - - public function __hx_getField_f(field:String, throwErrors:Bool, handleProperties:Bool):Float { - var res = FieldLookup.findHash(field, this.__hx_fields_f, this.__hx_length_f); - if (res >= 0) { - return this.__hx_dynamics_f[res]; - } - res = FieldLookup.findHash(field, this.__hx_fields, this.__hx_length); - if (res >= 0) { - return this.__hx_dynamics[res]; - } - - return 0.0; - } - - public function __hx_setField_f(field:String, value:Float, handleProperties:Bool):Float { - var res = FieldLookup.findHash(field, this.__hx_fields_f, this.__hx_length_f); - if (res >= 0) { - return this.__hx_dynamics_f[res] = value; - } else { - var res = FieldLookup.findHash(field, this.__hx_fields, this.__hx_length); - if (res >= 0) { - // return this.__hx_dynamics[res] = value; - FieldLookup.removeString(this.__hx_fields, this.__hx_length, res); - FieldLookup.removeDynamic(this.__hx_dynamics, this.__hx_length, res); - this.__hx_length--; - } - } - - this.__hx_fields_f = FieldLookup.insertString(this.__hx_fields_f, this.__hx_length_f, ~(res), field); - this.__hx_dynamics_f = FieldLookup.insertFloat(this.__hx_dynamics_f, this.__hx_length_f, ~(res), value); - this.__hx_length_f++; - return value; - } - - public function __hx_getFields(baseArr:Array):Void { - for (i in 0...this.__hx_length) { - baseArr.push(this.__hx_fields[i]); - } - for (i in 0...this.__hx_length_f) { - baseArr.push(this.__hx_fields_f[i]); - } - } - - public function __hx_invokeField(field:String, dynargs:NativeArray):Dynamic { - if (field == "toString") { - return this.toString(); - } - var fn:Function = this.__hx_getField(field, false, false, false); - if (fn == null) { - throw 'Cannot invoke field $field: It does not exist'; - } - - return untyped fn.__hx_invokeDynamic(dynargs); - } - - public function toString():String { - if (__hx_toString_depth >= 5) { - return "..."; - } - ++__hx_toString_depth; - try { - var s = __hx_toString(); - --__hx_toString_depth; - return s; - } catch (e:Dynamic) { - --__hx_toString_depth; - throw(e); - } - } - - function __hx_toString() { - var ts = this.__hx_getField("toString", false, false, false); - if (ts != null) - return ts(); - var ret = new StringBuf(); - ret.add("["); - var first = true; - for (f in Reflect.fields(this)) { - if (first) - first = false; - else - ret.add(","); - ret.add(" "); - ret.add(f); - ret.add(" : "); - ret.add(Reflect.field(this, f)); - } - if (!first) - ret.add(" "); - ret.add("]"); - return ret.toString(); - } -} - -@:keep @:native('haxe.lang.Enum') @:nativeGen -class HxEnum { - @:readOnly private var index(default, never):Int; - - public function new(index:Int) { - untyped this.index = index; - } - - public function getTag():String { - return throw new haxe.exceptions.NotImplementedException(); - } - - public function getParams():Array<{}> { - return []; - } - - public function toString():String { - return getTag(); - } -} - -@:keep @:native('haxe.lang.ParamEnum') @:nativeGen -private class ParamEnum extends HxEnum { - @:readOnly private var params(default, never):Vector; - - public function new(index:Int, params:Vector) { - super(index); - untyped this.params = params; - } - - override public function getParams():Array<{}> { - return params == null ? [] : cast params.toArray(); - } - - override public function toString():String { - if (params == null || params.length == 0) - return getTag(); - var ret = new StringBuf(); - ret.add(getTag()); - ret.add("("); - var first = true; - for (p in params) { - if (first) - first = false; - else - ret.add(","); - ret.add(p); - } - ret.add(")"); - return ret.toString(); - } - - public function equals(obj:Dynamic) { - if (obj == this) // we cannot use == as .Equals ! - return true; - var obj:ParamEnum = Std.isOfType(obj, ParamEnum) ? cast obj : null; - var ret = obj != null && Std.isOfType(obj, StdType.getEnum(cast this)) && obj.index == this.index; - if (!ret) - return false; - if (obj.params == this.params) - return true; - var len = 0; - if (obj.params == null || this.params == null || (len = this.params.length) != obj.params.length) - return false; - for (i in 0...len) { - if (!StdType.enumEq(obj.params[i], this.params[i])) - return false; - } - return true; - } - - public function hashCode():Int { - var h = 19; - if (params != null) - for (p in params) { - h = h * 31; - if (p != null) - untyped h += p.hashCode(); - } - h += index; - return h; - } -} diff --git a/std/java/internal/IEquatable.hx b/std/java/internal/IEquatable.hx deleted file mode 100644 index f557a19a76d..00000000000 --- a/std/java/internal/IEquatable.hx +++ /dev/null @@ -1,30 +0,0 @@ -/* - * 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 java.internal; - -@:native('haxe.lang.IEquatable') -@:keep -@:nativeGen -interface IEquatable { - public function equals(to:Dynamic):Bool; -} diff --git a/std/java/internal/Runtime.hx b/std/java/internal/Runtime.hx deleted file mode 100644 index 689d0eda847..00000000000 --- a/std/java/internal/Runtime.hx +++ /dev/null @@ -1,598 +0,0 @@ -/* - * 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 java.internal; - -/** - This class is meant for internal compiler use only. It provides the Haxe runtime - compatibility to the host language. Do not access it directly. -**/ -@:native('haxe.lang.Runtime') -@:nativeGen -@:classCode(' - public static java.lang.Object getField(haxe.lang.IHxObject obj, java.lang.String field, boolean throwErrors) - { - if (obj == null && !throwErrors) return null; - return obj.__hx_getField(field, throwErrors, false, false); - } - - public static double getField_f(haxe.lang.IHxObject obj, java.lang.String field, boolean throwErrors) - { - if (obj == null && !throwErrors) return 0.0; - return obj.__hx_getField_f(field, throwErrors, false); - } - - public static java.lang.Object setField(haxe.lang.IHxObject obj, java.lang.String field, java.lang.Object value) - { - return obj.__hx_setField(field, value, false); - } - - public static double setField_f(haxe.lang.IHxObject obj, java.lang.String field, double value) - { - return obj.__hx_setField_f(field, value, false); - } - - public static java.lang.Object callField(haxe.lang.IHxObject obj, java.lang.String field, java.lang.Object[] args) - { - return obj.__hx_invokeField(field, args); - } -') -@:keep class Runtime { - public static var undefined:Dynamic = {}; - - @:functionCode(' - return new haxe.lang.Closure(obj, field); - ') - public static function closure(obj:Dynamic, field:String):Dynamic { - return null; - } - - @:functionCode(' - if (v1 == v2) - return true; - if (v1 == null || v2 == null) - return false; - - if (v1 instanceof java.lang.Number) - { - if (!(v2 instanceof java.lang.Number)) - return false; - - java.lang.Number v1c = (java.lang.Number) v1; - java.lang.Number v2c = (java.lang.Number) v2; - if (v1 instanceof java.lang.Long || v2 instanceof java.lang.Long) - return v1c.longValue() == v2c.longValue(); - return v1c.doubleValue() == v2c.doubleValue(); - } else if (v1 instanceof java.lang.String || v1 instanceof haxe.lang.IEquatable) { //TODO see what happens with Boolean cases - return v1.equals(v2); - } - - return false; - ') - public static function eq(v1:Dynamic, v2:Dynamic):Bool { - return false; - } - - @:functionCode(' - if (v1 == v2) - return true; - - if (v1 instanceof java.lang.String || v1 instanceof haxe.lang.IEquatable) - { - return v1 != null && v1.equals(v2); - } else { - return v1 == v2; - } - ') - public static function refEq(v1:{}, v2:{}):Bool { - return false; - } - - @:functionCode(' - return v1 == v2 || (v1 != null && v1.equals(v2)); - ') - public static function valEq(v1:{}, v2:{}):Bool { - return false; - } - - @:functionCode(' - return (obj == null) ? 0.0 : ((java.lang.Number) obj).doubleValue(); - ') - public static function toDouble(obj:Dynamic):Float { - return 0.0; - } - - public static function toBool(obj:java.lang.Boolean):Bool { - return obj == null ? false : obj.booleanValue(); - } - - @:functionCode(' - return (obj == null) ? 0 : ((java.lang.Number) obj).intValue(); - ') - public static function toInt(obj:Dynamic):Int { - return 0; - } - - public static function toLong(obj:Dynamic):haxe.Int64 { - return obj == null ? 0 : (obj : java.lang.Number).longValue(); - } - - @:functionCode(' - if (obj != null && obj instanceof java.lang.Number) - { - return true; - } else { - return false; - } - ') - public static function isDouble(obj:Dynamic):Bool { - return false; - } - - @:overload public static function isInt(obj:Dynamic):Bool { - if (Std.isOfType(obj, java.lang.Number)) { - var n:java.lang.Number = obj; - return n.doubleValue() == n.intValue(); - } else { - return false; - } - } - - @:overload public static function isInt(num:java.lang.Number):Bool { - return num != null && num.doubleValue() == num.intValue(); - } - - @:functionCode(' - java.lang.Class cl = null; - if (o instanceof java.lang.Class) - { - if (o == java.lang.String.class) - return field.equals("fromCharCode"); - - cl = (java.lang.Class) o; - } else if (o instanceof java.lang.String) { - return haxe.lang.StringRefl.handleGetField( (java.lang.String) o, field, false) != null; - } else { - cl = o.getClass(); - } - - try - { - java.lang.reflect.Field f = cl.getField(field); - return true; - } - catch(Throwable t) - { - java.lang.reflect.Method[] ms = cl.getMethods(); - for (int i = 0; i < ms.length; i++) - { - if (ms[i].getName().equals(field)) - { - return true; - } - } - } - - return false; - ') - public static function slowHasField(o:Dynamic, field:String):Bool { - return false; - } - - @:functionCode(' - if (v1 == v2) - return 0; - if (v1 == null) return -1; - if (v2 == null) return 1; - - if (v1 instanceof java.lang.Number || v2 instanceof java.lang.Number) - { - java.lang.Number v1c = (java.lang.Number) v1; - java.lang.Number v2c = (java.lang.Number) v2; - - if (v1 instanceof java.lang.Long || v2 instanceof java.lang.Long) - { - long l1 = (v1 == null) ? 0L : v1c.longValue(); - long l2 = (v2 == null) ? 0L : v2c.longValue(); - return (l1 < l2) ? -1 : (l1 > l2) ? 1 : 0; - } else { - double d1 = (v1 == null) ? 0.0 : v1c.doubleValue(); - double d2 = (v2 == null) ? 0.0 : v2c.doubleValue(); - - return (d1 < d2) ? -1 : (d1 > d2) ? 1 : 0; - } - } - //if it\'s not a number it must be a String - return ((java.lang.String) v1).compareTo((java.lang.String) v2); - ') - public static function compare(v1:Dynamic, v2:Dynamic):Int { - return 0; - } - - @:functionCode(' - if (v1 instanceof java.lang.String || v2 instanceof java.lang.String) - return toString(v1) + toString(v2); - - if (v1 instanceof java.lang.Number || v2 instanceof java.lang.Number) - { - java.lang.Number v1c = (java.lang.Number) v1; - java.lang.Number v2c = (java.lang.Number) v2; - - double d1 = (v1 == null) ? 0.0 : v1c.doubleValue(); - double d2 = (v2 == null) ? 0.0 : v2c.doubleValue(); - - return d1 + d2; - } - - throw new java.lang.IllegalArgumentException("Cannot dynamically add " + v1 + " and " + v2); - ') - public static function plus(v1:Dynamic, v2:Dynamic):Dynamic { - return null; - } - - @:functionCode(' - - if (obj == null) - if (throwErrors) - throw new java.lang.NullPointerException("Cannot access field \'" + field + "\' of null."); - else - return null; - - java.lang.Class cl = null; - try - { - if (obj instanceof java.lang.Class) - { - if (obj == java.lang.String.class && field.equals("fromCharCode")) - return new haxe.lang.Closure(haxe.lang.StringExt.class, field); - - cl = (java.lang.Class) obj; - obj = null; - } else if (obj instanceof java.lang.String) { - return haxe.lang.StringRefl.handleGetField((java.lang.String) obj, field, throwErrors); - } else { - cl = obj.getClass(); - } - - java.lang.reflect.Field f = cl.getField(field); - f.setAccessible(true); - return f.get(obj); - } catch (Throwable t) - { - try - { - java.lang.reflect.Method[] ms = cl.getMethods(); - for (int i = 0; i < ms.length; i++) - { - if (ms[i].getName().equals(field)) - { - return new haxe.lang.Closure(obj != null ? obj : cl, field); - } - } - } catch (Throwable t2) - { - - } - - if (throwErrors) - throw (java.lang.RuntimeException)haxe.Exception.thrown(t); - - return null; - } - - ') - public static function slowGetField(obj:Dynamic, field:String, throwErrors:Bool):Dynamic { - return null; - } - - @:functionCode(' - java.lang.Class cl = null; - if (obj instanceof java.lang.Class) - { - cl = (java.lang.Class) obj; - obj = null; - } else { - cl = obj.getClass(); - } - - try { - java.lang.reflect.Field f = cl.getField(field); - f.setAccessible(true); - - //FIXME we must evaluate if field to be set receives either int or double - if (isInt(value)) - { - f.setInt(obj, toInt(value)); - } else if (isDouble(value)) { - f.setDouble(obj, toDouble(value)); - } else { - f.set(obj, value); - } - return value; - } - catch (Throwable t) - { - throw (java.lang.RuntimeException)haxe.Exception.thrown(t); - } - ') - public static function slowSetField(obj:Dynamic, field:String, value:Dynamic):Dynamic { - return null; - } - - @:functionCode(' - java.lang.Class cl = null; - if (obj instanceof java.lang.Class) - { - if (obj == java.lang.String.class && field.equals("fromCharCode")) - return haxe.lang.StringExt.fromCharCode(toInt(args[0])); - - cl = (java.lang.Class) obj; - obj = null; - } else if (obj instanceof java.lang.String) { - return haxe.lang.StringRefl.handleCallField((java.lang.String) obj, field, args); - } else { - cl = obj.getClass(); - } - - if (args == null) args = new java.lang.Object[0]; - - int len = args.length; - java.lang.Class[] cls = new java.lang.Class[len]; - java.lang.Object[] objs = new java.lang.Object[len]; - - java.lang.reflect.Method[] ms = cl.getMethods(); - int msl = ms.length; - int realMsl = 0; - for(int i =0; i < msl; i++) - { - if (!ms[i].getName().equals(field) || (!ms[i].isVarArgs() && ms[i].getParameterTypes().length != len)) - { - ms[i] = null; - } else { - ms[realMsl] = ms[i]; - if (realMsl != i) - ms[i] = null; - realMsl++; - } - } - - boolean hasNumber = false; - - for (int i = 0; i < len; i++) - { - Object o = args[i]; - if (o == null) - { - continue; //can be anything - } - objs[i]= o; - cls[i] = o.getClass(); - boolean isNum = false; - - if (o instanceof java.lang.Number) - { - cls[i] = java.lang.Number.class; - isNum = hasNumber = true; - } else if (o instanceof java.lang.Boolean) { - cls[i] = java.lang.Boolean.class; - isNum = true; - } - - msl = realMsl; - realMsl = 0; - - for (int j = 0; j < msl; j++) - { - java.lang.Class[] allcls = ms[j].getParameterTypes(); - if (i < allcls.length) - { - if (! ((isNum && allcls[i].isPrimitive()) || allcls[i].isAssignableFrom(cls[i])) ) - { - ms[j] = null; - } else { - ms[realMsl] = ms[j]; - if (realMsl != j) - ms[j] = null; - realMsl++; - } - } - } - - } - - java.lang.reflect.Method found; - if (ms.length == 0 || (found = ms[0]) == null) - throw (java.lang.RuntimeException)haxe.Exception.thrown("No compatible method found for: " + field); - - if (hasNumber) - { - java.lang.Class[] allcls = found.getParameterTypes(); - - for (int i = 0; i < len; i++) - { - java.lang.Object o = objs[i]; - if (o instanceof java.lang.Number) - { - java.lang.Class curCls = null; - if (i < allcls.length) - { - curCls = allcls[i]; - if (!curCls.isAssignableFrom(o.getClass())) - { - String name = curCls.getName(); - if (name.equals("double") || name.equals("java.lang.Double")) - { - objs[i] = ((java.lang.Number)o).doubleValue(); - } else if (name.equals("int") || name.equals("java.lang.Integer")) - { - objs[i] = ((java.lang.Number)o).intValue(); - } else if (name.equals("float") || name.equals("java.lang.Float")) - { - objs[i] = ((java.lang.Number)o).floatValue(); - } else if (name.equals("byte") || name.equals("java.lang.Byte")) - { - objs[i] = ((java.lang.Number)o).byteValue(); - } else if (name.equals("short") || name.equals("java.lang.Short")) - { - objs[i] = ((java.lang.Number)o).shortValue(); - } else if (name.equals("long") || name.equals("java.lang.Long")) - { - objs[i] = ((java.lang.Number)o).longValue(); - } - } - } //else varargs not handled TODO - } - } - } - - try { - found.setAccessible(true); - return found.invoke(obj, objs); - } - - catch (java.lang.reflect.InvocationTargetException e) - { - throw (java.lang.RuntimeException)haxe.Exception.thrown(e.getCause()); - } - - catch (Throwable t) - { - throw (java.lang.RuntimeException)haxe.Exception.thrown(t); - } - ') - public static function slowCallField(obj:Dynamic, field:String, args:java.NativeArray):Dynamic { - return null; - } - - @:functionCode(' - if (obj instanceof haxe.lang.IHxObject) - { - return ((haxe.lang.IHxObject) obj).__hx_invokeField(field, args); - } - - return slowCallField(obj, field, args); - ') - public static function callField(obj:Dynamic, field:String, args:java.NativeArray):Dynamic { - return null; - } - - @:functionCode(' - - if (obj instanceof haxe.lang.IHxObject) - return ((haxe.lang.IHxObject) obj).__hx_getField(field, throwErrors, false, false); - - return slowGetField(obj, field, throwErrors); - - ') - public static function getField(obj:Dynamic, field:String, throwErrors:Bool):Dynamic { - return null; - } - - @:functionCode(' - - if (obj instanceof haxe.lang.IHxObject) - return ((haxe.lang.IHxObject) obj).__hx_getField_f(field, throwErrors, false); - - return toDouble(slowGetField(obj, field, throwErrors)); - - ') - public static function getField_f(obj:Dynamic, field:String, throwErrors:Bool):Float { - return 0.0; - } - - @:functionCode(' - - if (obj instanceof haxe.lang.IHxObject) - return ((haxe.lang.IHxObject) obj).__hx_setField(field, value, false); - - return slowSetField(obj, field, value); - - ') - public static function setField(obj:Dynamic, field:String, value:Dynamic):Dynamic { - return null; - } - - @:functionCode(' - - if (obj instanceof haxe.lang.IHxObject) - return ((haxe.lang.IHxObject) obj).__hx_setField_f(field, value, false); - - return toDouble(slowSetField(obj, field, value)); - - ') - public static function setField_f(obj:Dynamic, field:String, value:Float):Float { - return 0.0; - } - - public static function toString(obj:Dynamic):String { - if (obj == null) - return null; - - if (Std.isOfType(obj, java.lang.Number) && !Std.isOfType(obj, java.lang.Integer.IntegerClass) && isInt((obj : java.lang.Number))) - return java.lang.Integer._toString(toInt(obj)); - return untyped obj.toString(); - } - - public static function isFinite(v:Float):Bool { - return (v == v) && !java.lang.Double.DoubleClass._isInfinite(v); - } - - public static function getIntFromNumber(n:java.lang.Number):Int { - return n == null ? 0 : n.intValue(); - } - - public static function getFloatFromNumber(n:java.lang.Number):Float { - return n == null ? 0.0 : n.doubleValue(); - } - - public static function getInt64FromNumber(n:java.lang.Number):java.StdTypes.Int64 { - return n == null ? 0.0 : n.longValue(); - } - - public static function numToInteger(num:java.lang.Number):java.lang.Integer { - return num == null ? null : (Std.isOfType(num, java.lang.Integer.IntegerClass) ? cast num : java.lang.Integer.valueOf(num.intValue())); - } - - public static function numToDouble(num:java.lang.Number):java.lang.Double { - return num == null ? null : (Std.isOfType(num, java.lang.Double.DoubleClass) ? cast num : java.lang.Double.valueOf(num.doubleValue())); - } - - public static function numToFloat(num:java.lang.Number):java.lang.Float { - return num == null ? null : (Std.isOfType(num, java.lang.Float.FloatClass) ? cast num : java.lang.Float.valueOf(num.floatValue())); - } - - public static function numToByte(num:java.lang.Number):java.lang.Byte { - return num == null ? null : (Std.isOfType(num, java.lang.Byte.ByteClass) ? cast num : java.lang.Byte.valueOf(num.byteValue())); - } - - public static function numToLong(num:java.lang.Number):java.lang.Long { - return num == null ? null : (Std.isOfType(num, java.lang.Long.LongClass) ? cast num : java.lang.Long.valueOf(num.longValue())); - } - - public static function numToShort(num:java.lang.Number):java.lang.Short { - return num == null ? null : (Std.isOfType(num, java.lang.Short.ShortClass) ? cast num : java.lang.Short.valueOf(num.shortValue())); - } -} - -@:keep @:native("haxe.lang.EmptyObject") enum EmptyObject { - EMPTY; -} diff --git a/std/java/internal/StringExt.hx b/std/java/internal/StringExt.hx deleted file mode 100644 index 886eba58742..00000000000 --- a/std/java/internal/StringExt.hx +++ /dev/null @@ -1,253 +0,0 @@ -/* - * 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 java.internal; - -import java.internal.Function; - -private typedef NativeString = String; - -@:keep @:nativeGen @:native("haxe.lang.StringExt") private class StringExt { - @:functionCode(' - if ( index >= me.length() || index < 0 ) - return ""; - else - return java.lang.Character.toString(me.charAt(index)); - ') - public static function charAt(me:NativeString, index:Int):NativeString { - return null; - } - - @:functionCode(' - if ( index >= me.length() || index < 0 ) - return null; - else - return (int) me.charAt(index); - ') - public static function charCodeAt(me:NativeString, index:Int):Null { - return null; - } - - @:functionCode(' - int sIndex = (startIndex != null ) ? (haxe.lang.Runtime.toInt(startIndex)) : 0; - if(str == "") { - int length = me.length(); - if(sIndex < 0) { - sIndex = length + sIndex; - if(sIndex < 0) sIndex = 0; - } - return sIndex > length ? length : sIndex; - } - if (sIndex >= me.length() || sIndex < 0) - return -1; - return me.indexOf(str, sIndex); - ') - public static function indexOf(me:NativeString, str:NativeString, ?startIndex:Int):Int { - return -1; - } - - @:functionCode(' - int sIndex = (startIndex != null ) ? (haxe.lang.Runtime.toInt(startIndex)) : (me.length() - 1); - if (sIndex > me.length() || sIndex < 0) - sIndex = me.length() - 1; - else if (sIndex < 0) - return -1; - if (str.length() == 0) { - return startIndex == null || haxe.lang.Runtime.toInt(startIndex) > me.length() ? me.length() : haxe.lang.Runtime.toInt(startIndex); - } - return me.lastIndexOf(str, sIndex); - ') - public static function lastIndexOf(me:NativeString, str:NativeString, ?startIndex:Int):Int { - return -1; - } - - @:functionCode(' - Array ret = new Array(); - - int slen = delimiter.length(); - if (slen == 0) - { - int len = me.length(); - for (int i = 0; i < len; i++) - { - ret.push(me.substring(i, i + 1)); - } - } else { - int start = 0; - int pos = me.indexOf(delimiter, start); - - while (pos >= 0) - { - ret.push(me.substring(start, pos)); - - start = pos + slen; - pos = me.indexOf(delimiter, start); - } - - ret.push(me.substring(start)); - } - return ret; - ') - public static function split(me:NativeString, delimiter:NativeString):Array { - return null; - } - - @:functionCode(' - int meLen = me.length(); - int targetLen = meLen; - if (len != null) - { - targetLen = haxe.lang.Runtime.toInt(len); - if (targetLen == 0) - return ""; - if( pos != 0 && targetLen < 0 ){ - return ""; - } - } - - if( pos < 0 ){ - pos = meLen + pos; - if( pos < 0 ) pos = 0; - } else if( targetLen < 0 ){ - targetLen = meLen + targetLen - pos; - } - - if( pos + targetLen > meLen ){ - targetLen = meLen - pos; - } - - if ( pos < 0 || targetLen <= 0 ) return ""; - - return me.substring(pos, pos + targetLen); - ') - public static function substr(me:NativeString, pos:Int, ?len:Int):NativeString { - return null; - } - - @:functionCode(' - int endIdx; - int len = me.length(); - if ( endIndex == null) { - endIdx = len; - } else if ( (endIdx = haxe.lang.Runtime.toInt(endIndex)) < 0 ) { - endIdx = 0; - } else if ( endIdx > len ) { - endIdx = len; - } - - if ( startIndex < 0 ) { - startIndex = 0; - } else if ( startIndex > len ) { - startIndex = len; - } - - if ( startIndex > endIdx ) { - int tmp = startIndex; - startIndex = endIdx; - endIdx = tmp; - } - - return me.substring(startIndex, endIdx); - - ') - public static function substring(me:NativeString, startIndex:Int, ?endIndex:Int):NativeString { - return null; - } - - public static function toString(me:NativeString):NativeString { - return me; - } - - @:functionCode(' - return me.toLowerCase(); - ') - public static function toLowerCase(me:NativeString):NativeString { - return null; - } - - @:functionCode(' - return me.toUpperCase(); - ') - public static function toUpperCase(me:NativeString):NativeString { - return null; - } - - public static function toNativeString(me:NativeString):NativeString { - return me; - } - - public static function fromCharCode(code:Int):String { - return new String(java.lang.Character.toChars(code)); - } -} - -@:keep @:nativeGen @:native('haxe.lang.StringRefl') private class StringRefl { - public static var fields = [ - "length", "toUpperCase", "toLowerCase", "charAt", "charCodeAt", "indexOf", "lastIndexOf", "split", "substr", "substring" - ]; - - public static function handleGetField(str:NativeString, f:NativeString, throwErrors:Bool):Dynamic { - switch (f) { - case "length": - return str.length; - case "toUpperCase", "toLowerCase", "charAt", "charCodeAt", "indexOf", "lastIndexOf", "split", "substr", "substring": - return new Closure(str, f); - default: - if (throwErrors) - throw "Field not found: '" + f + "' in String"; - else - return null; - } - } - - public static function handleCallField(str:NativeString, f:NativeString, args:java.NativeArray):Dynamic { - var _args:java.NativeArray; - if (args == null) { - _args = java.NativeArray.make(str); - } else { - _args = new java.NativeArray(args.length + 1); - _args[0] = str; - for (i in 0...args.length) - _args[i + 1] = args[i]; - } - return Runtime.slowCallField(StringExt, f, _args); - } -} - -@:keep @:native('haxe.lang.NativeString') private extern class JavaString { - // name collides with Haxe's - function _charAt(idx:Int):java.StdTypes.Char16; - function codePointAt(idx:Int):Int; - function codePointBefore(idx:Int):Int; - function codePointCount(begin:Int, end:Int):Int; - function offsetByCodePoints(index:Int, codePointOffset:Int):Int; - function getChars(srcBegin:Int, srcEnd:Int, dst:java.NativeArray, dstBegin:Int):Void; - - function startsWith(prefix:String):Bool; - function endsWith(suffix:String):Bool; - function _indexOf(str:String, fromIndex:Int):Int; - function _lastIndexOf(str:String, fromIndex:Int):Int; - function _substring(begin:Int, end:Int):String; - function replace(old:String, nw:String):String; - function _split(regex:String):java.NativeArray; - function trim():String; -} diff --git a/std/jvm/_std/haxe/Rest.hx b/std/jvm/_std/haxe/Rest.hx index 1d31c5e9c26..f0d6788a933 100644 --- a/std/jvm/_std/haxe/Rest.hx +++ b/std/jvm/_std/haxe/Rest.hx @@ -27,6 +27,7 @@ abstract Rest(NativeRest) { return new Rest(result); } + @:noDoc @:from extern inline static function fromNative(a:java.NativeArray):Rest { return new Rest(Vector.fromData(a)); } diff --git a/tests/README.md b/tests/README.md index f55ccff6c21..0cc78263900 100644 --- a/tests/README.md +++ b/tests/README.md @@ -9,7 +9,7 @@ We have a number of test suites, which are placed in their own folders in this d It is possible to run it in local machines too: 1. Change to this directory. - 2. Define the test target by `export TEST=$TARGET` (or `set "TEST=$TARGET"` on Windows), where `$TARGET` should be a comma-seperated list of targets, e.g. `neko,macro`. Possible targets are `macro`, `neko`, `js`, `lua`, `php`, `cpp`, `cppia`, `flash`, `java`, `jvm`, `cs`, `python`, and `hl`. + 2. Define the test target by `export TEST=$TARGET` (or `set "TEST=$TARGET"` on Windows), where `$TARGET` should be a comma-seperated list of targets, e.g. `neko,macro`. Possible targets are `macro`, `neko`, `js`, `lua`, `php`, `cpp`, `cppia`, `flash`, `jvm`, `python`, and `hl`. 3. Run the script: `haxe RunCi.hxml`. Note that the script will try to look for test dependencies and install them if they are not found. Look at the `getXXXDependencies` functions for the details. diff --git a/tests/RunCi.hx b/tests/RunCi.hx index 4016da62e1b..f9700c5f897 100644 --- a/tests/RunCi.hx +++ b/tests/RunCi.hx @@ -63,12 +63,8 @@ class RunCi { runci.targets.Cpp.run(args, false, true); case Js: runci.targets.Js.run(args); - case Java: - runci.targets.Java.run(args); case Jvm: runci.targets.Jvm.run(args); - case Cs: - runci.targets.Cs.run(args); case Flash: runci.targets.Flash.run(args); case Hl: diff --git a/tests/misc/README.md b/tests/misc/README.md index 53a3f126a97..56fae623032 100644 --- a/tests/misc/README.md +++ b/tests/misc/README.md @@ -24,7 +24,7 @@ To run tests only for a single project use the following command: `haxe -D MISC_ ### Running target specific projects locally -Tests specific to some targets (python, cs) reside in their own separate folder (respectively `tests/misc/python` and `tests/misc/cs`). +Tests specific to some targets (python, hl) reside in their own separate folder (respectively `tests/misc/python` and `tests/misc/hl`). Chdir to `tests/misc/{target}` and run `haxe run.hxml` to run these tests. diff --git a/tests/misc/cs/csTwoLibs/.gitignore b/tests/misc/cs/csTwoLibs/.gitignore deleted file mode 100644 index ba077a4031a..00000000000 --- a/tests/misc/cs/csTwoLibs/.gitignore +++ /dev/null @@ -1 +0,0 @@ -bin diff --git a/tests/misc/cs/csTwoLibs/Lib1.hx b/tests/misc/cs/csTwoLibs/Lib1.hx deleted file mode 100644 index ab2c3428f9b..00000000000 --- a/tests/misc/cs/csTwoLibs/Lib1.hx +++ /dev/null @@ -1,7 +0,0 @@ -@:keep class Lib1 -{ - public static function test() - { - return { longInexistentName:true, otherName:true, yetAnotherName:true, fdskljdflskjf:true, xxy:true }; - } -} diff --git a/tests/misc/cs/csTwoLibs/Main.hx b/tests/misc/cs/csTwoLibs/Main.hx deleted file mode 100644 index bacffef92a8..00000000000 --- a/tests/misc/cs/csTwoLibs/Main.hx +++ /dev/null @@ -1,22 +0,0 @@ -class Main -{ - public static function main() - { - var asm = cs.system.reflection.Assembly.LoadFile(sys.FileSystem.fullPath("bin/lib1/bin/lib1.dll")); - var name = #if no_root "haxe.root.Lib1" #else "Lib1" #end; - var tp:Dynamic = asm.GetType(name); - var obj = tp.test(); - trace(obj); - for (field in Reflect.fields(obj)) - { - var val:Dynamic = Reflect.field(obj,field); - if (val != true) - throw 'Value $val for field $field'; - } - var names = ["longInexistentName","otherName","yetAnotherName","fdskljdflskjf","xxy"]; - var n2 = Reflect.fields(obj); - names.sort(Reflect.compare); - n2.sort(Reflect.compare); - if (names.toString() != n2.toString()) throw 'Mismatch: $names and $n2'; - } -} diff --git a/tests/misc/cs/csTwoLibs/compile-1.hxml b/tests/misc/cs/csTwoLibs/compile-1.hxml deleted file mode 100644 index 8d1ded25b7e..00000000000 --- a/tests/misc/cs/csTwoLibs/compile-1.hxml +++ /dev/null @@ -1,17 +0,0 @@ ---cmd rm -rf bin ---next -cs.Boot ---dce no --cs bin/haxeboot ---next ---net-lib bin/haxeboot/bin/haxeboot.dll ---dce no --D dll_import -Lib1 --cs bin/lib1 ---next ---net-lib bin/haxeboot/bin/haxeboot.dll ---dce no --D dll_import ---main Main --cs bin/main diff --git a/tests/misc/cs/csTwoLibs/compile-2.hxml b/tests/misc/cs/csTwoLibs/compile-2.hxml deleted file mode 100644 index d068487ca42..00000000000 --- a/tests/misc/cs/csTwoLibs/compile-2.hxml +++ /dev/null @@ -1,20 +0,0 @@ ---cmd rm -rf bin ---next -cs.Boot ---dce no --cs bin/haxeboot --D no_root ---next ---net-lib bin/haxeboot/bin/haxeboot.dll ---dce no --D dll_import --D no_root -Lib1 --cs bin/lib1 ---next ---net-lib bin/haxeboot/bin/haxeboot.dll ---dce no --D dll_import --D no_root ---main Main --cs bin/main diff --git a/tests/misc/cs/csTwoLibs/compile-3.hxml b/tests/misc/cs/csTwoLibs/compile-3.hxml deleted file mode 100644 index 71373e56fc9..00000000000 --- a/tests/misc/cs/csTwoLibs/compile-3.hxml +++ /dev/null @@ -1,20 +0,0 @@ ---cmd rm -rf bin ---next -cs.Boot ---dce no --cs bin/haxeboot --D erase_generics ---next ---net-lib bin/haxeboot/bin/haxeboot.dll ---dce no --D dll_import --D erase_generics -Lib1 --cs bin/lib1 ---next ---net-lib bin/haxeboot/bin/haxeboot.dll ---dce no --D dll_import --D erase_generics ---main Main --cs bin/main diff --git a/tests/misc/cs/csTwoLibs/compile-4.hxml b/tests/misc/cs/csTwoLibs/compile-4.hxml deleted file mode 100644 index 57da36133b0..00000000000 --- a/tests/misc/cs/csTwoLibs/compile-4.hxml +++ /dev/null @@ -1,23 +0,0 @@ ---cmd rm -rf bin ---next -cs.Boot ---dce no --cs bin/haxeboot --D erase_generics --D no_root ---next ---net-lib bin/haxeboot/bin/haxeboot.dll ---dce no --D dll_import --D erase_generics --D no_root -Lib1 --cs bin/lib1 ---next ---net-lib bin/haxeboot/bin/haxeboot.dll ---dce no --D dll_import --D erase_generics --D no_root ---main Main --cs bin/main diff --git a/tests/misc/cs/projects/Issue11350/Main.hx b/tests/misc/cs/projects/Issue11350/Main.hx deleted file mode 100644 index 850d4cc3606..00000000000 --- a/tests/misc/cs/projects/Issue11350/Main.hx +++ /dev/null @@ -1,10 +0,0 @@ -class Main { - public static function main() {} - - public static function forComparable>(): T->T->Void - return (a: T, b: T) -> {} -} - -typedef Comparable = { - public function compareTo(that : T) : Int; -} diff --git a/tests/misc/cs/projects/Issue11350/compile.hxml b/tests/misc/cs/projects/Issue11350/compile.hxml deleted file mode 100644 index 9f9209b7ba8..00000000000 --- a/tests/misc/cs/projects/Issue11350/compile.hxml +++ /dev/null @@ -1,3 +0,0 @@ ---main Main --cs bin --D net-ver=45 diff --git a/tests/misc/cs/projects/Issue3526/.gitignore b/tests/misc/cs/projects/Issue3526/.gitignore deleted file mode 100644 index 3adf1f4d8fb..00000000000 --- a/tests/misc/cs/projects/Issue3526/.gitignore +++ /dev/null @@ -1 +0,0 @@ -/cs \ No newline at end of file diff --git a/tests/misc/cs/projects/Issue3526/IncompatibleCombinations.hx b/tests/misc/cs/projects/Issue3526/IncompatibleCombinations.hx deleted file mode 100644 index b1e26ddf0fe..00000000000 --- a/tests/misc/cs/projects/Issue3526/IncompatibleCombinations.hx +++ /dev/null @@ -1,28 +0,0 @@ -import cs.Constraints; -import haxe.Constraints.Constructible; - -@:nativeGen -class StructAndConstructibleVoid>> {} - -@:nativeGen -class ConstructibleAndStructVoid> & CsStruct> {} - -@:nativeGen -class StructAndClass {} - -@:nativeGen -class ClassAndStruct {} - -#if (cs_ver >= "7.3") -@:nativeGen -class UnmanagedAndStruct {} - -@:nativeGen -class StructAndUnmanaged {} - -@:nativeGen -class UnmanagedAndConstructibleVoid>> {} - -@:nativeGen -class ConstructibleAndUnmanagedVoid> & CsUnmanaged> {} -#end \ No newline at end of file diff --git a/tests/misc/cs/projects/Issue3526/Main.hx b/tests/misc/cs/projects/Issue3526/Main.hx deleted file mode 100644 index 53a9b1a7284..00000000000 --- a/tests/misc/cs/projects/Issue3526/Main.hx +++ /dev/null @@ -1,72 +0,0 @@ -import cs.Constraints; -import haxe.Constraints.Constructible; - -@:classCode(" - public static void testClass(T t) where T : class {} - public static void testStruct(T t) where T : struct {} - public static void testConstructible(T t) where T : new() {} - public static void testConstructibleClass(T t) where T : class, new() {} -") -class TestCs { - extern public static function testClass(t:T):Void; - extern public static function testStruct(t:T):Void; - extern public static function testConstructibleVoid>>(t:T):Void; - extern public static function testConstructibleClassVoid> & CsClass>(t:T):Void; -} - -@:nativeGen -class Main { - public static function main() { - testClass(new Array()); - TestCs.testClass(new Class_(new Array()).value); - - testStruct(42); - TestCs.testStruct(new Struct(42).value); - - testConstructible(new haxe.Serializer()); - TestCs.testConstructible(new Constructible_(new haxe.Serializer()).value); - - testConstructibleClass(new haxe.Serializer()); - TestCs.testConstructibleClass(new ConstructibleClass(new haxe.Serializer()).value); - } - - static function testClass(value:T) TestCs.testClass(value); - static function testStruct(value:T) TestCs.testStruct(value); - static function testConstructibleVoid>>(value:T) TestCs.testConstructible(value); - static function testConstructibleClassVoid> & CsClass>(value:T) TestCs.testConstructibleClass(value); -} - -@:nativeGen -class Class_ { - public var value:T; - public function new(value:T) this.value = value; -} - -@:nativeGen -class Struct { - public var value:T; - public function new(value:T) this.value = value; -} - -@:nativeGen -class Constructible_Void>> { - public var value:T; - public function new(value:T) this.value = value; -} - -@:nativeGen -class ConstructibleClassVoid> & CsClass> { - public var value:T; - public function new(value:T) this.value = value; -} - -@:nativeGen -class StructT {} - -#if (cs_ver >= "7.3") -@:nativeGen -class Unmanaged {} - -@:nativeGen -class UnmanagedClass {} -#end \ No newline at end of file diff --git a/tests/misc/cs/projects/Issue3526/compile-7.3.hxml b/tests/misc/cs/projects/Issue3526/compile-7.3.hxml deleted file mode 100644 index 3cee3c59b85..00000000000 --- a/tests/misc/cs/projects/Issue3526/compile-7.3.hxml +++ /dev/null @@ -1,4 +0,0 @@ --cs cs --D no-compilation --D cs_ver=7.3 -Main \ No newline at end of file diff --git a/tests/misc/cs/projects/Issue3526/compile.hxml b/tests/misc/cs/projects/Issue3526/compile.hxml deleted file mode 100644 index 182b38b6eb8..00000000000 --- a/tests/misc/cs/projects/Issue3526/compile.hxml +++ /dev/null @@ -1,2 +0,0 @@ --cs cs -Main \ No newline at end of file diff --git a/tests/misc/cs/projects/Issue3526/incompatible-combinations-fail.hxml b/tests/misc/cs/projects/Issue3526/incompatible-combinations-fail.hxml deleted file mode 100644 index 347dfd45b83..00000000000 --- a/tests/misc/cs/projects/Issue3526/incompatible-combinations-fail.hxml +++ /dev/null @@ -1,4 +0,0 @@ --cs cs --D no-compilation --D cs_ver=7.3 -IncompatibleCombinations \ No newline at end of file diff --git a/tests/misc/cs/projects/Issue3526/incompatible-combinations-fail.hxml.stderr b/tests/misc/cs/projects/Issue3526/incompatible-combinations-fail.hxml.stderr deleted file mode 100644 index c715da8c83e..00000000000 --- a/tests/misc/cs/projects/Issue3526/incompatible-combinations-fail.hxml.stderr +++ /dev/null @@ -1,8 +0,0 @@ -IncompatibleCombinations.hx:5: characters 1-70 : The new() constraint cannot be combined with the struct constraint. -IncompatibleCombinations.hx:8: characters 1-70 : The new() constraint cannot be combined with the struct constraint. -IncompatibleCombinations.hx:11: characters 1-46 : The class constraint cannot be combined with the struct constraint. -IncompatibleCombinations.hx:14: characters 1-46 : The class constraint cannot be combined with the struct constraint. -IncompatibleCombinations.hx:18: characters 1-54 : The unmanaged constraint cannot be combined with the struct constraint. -IncompatibleCombinations.hx:21: characters 1-54 : The unmanaged constraint cannot be combined with the struct constraint. -IncompatibleCombinations.hx:24: characters 1-76 : The unmanaged constraint cannot be combined with the new() constraint. -IncompatibleCombinations.hx:27: characters 1-76 : The unmanaged constraint cannot be combined with the new() constraint. \ No newline at end of file diff --git a/tests/misc/cs/projects/Issue3703/Main.hx b/tests/misc/cs/projects/Issue3703/Main.hx deleted file mode 100644 index 30006534b16..00000000000 --- a/tests/misc/cs/projects/Issue3703/Main.hx +++ /dev/null @@ -1,15 +0,0 @@ -class Main { - static function main() { - var a = ["hello"]; - sortArray(a); // works properly - sortArrayInline(a); // generates wrong code - } - - static function sortArray(a:Array):Void { - cs.system.Array.Sort(@:privateAccess a.__a, 0, a.length); - } - - static inline function sortArrayInline(a:Array):Void { - cs.system.Array.Sort(@:privateAccess a.__a, 0, a.length); - } -} diff --git a/tests/misc/cs/projects/Issue3703/Test.hx b/tests/misc/cs/projects/Issue3703/Test.hx deleted file mode 100644 index 97e3328e1b7..00000000000 --- a/tests/misc/cs/projects/Issue3703/Test.hx +++ /dev/null @@ -1,15 +0,0 @@ -class A {} - -@:nativeGen -class B {} - -class C { - var a:A; - var b:B; - - function f():A return null; -} - -class D extends C { - override function f():A return null; -} diff --git a/tests/misc/cs/projects/Issue3703/compile.hxml b/tests/misc/cs/projects/Issue3703/compile.hxml deleted file mode 100644 index 85efa756f17..00000000000 --- a/tests/misc/cs/projects/Issue3703/compile.hxml +++ /dev/null @@ -1,3 +0,0 @@ --main Main -Test --cs bin diff --git a/tests/misc/cs/projects/Issue4002/Main.hx b/tests/misc/cs/projects/Issue4002/Main.hx deleted file mode 100644 index 91516303caf..00000000000 --- a/tests/misc/cs/projects/Issue4002/Main.hx +++ /dev/null @@ -1,19 +0,0 @@ -import cs.system.WeakReference_1; - -class Main { - public static function main() { - new Test(new A()); - } -} - -@:nativeGen -class Test { - public function new(a:T) { - var ref:WeakReference_1 = new WeakReference_1(a); - } -} - -class A { - public function new() {} -} - diff --git a/tests/misc/cs/projects/Issue4002/compile.hxml b/tests/misc/cs/projects/Issue4002/compile.hxml deleted file mode 100644 index 9f9209b7ba8..00000000000 --- a/tests/misc/cs/projects/Issue4002/compile.hxml +++ /dev/null @@ -1,3 +0,0 @@ ---main Main --cs bin --D net-ver=45 diff --git a/tests/misc/cs/projects/Issue4116/.gitignore b/tests/misc/cs/projects/Issue4116/.gitignore deleted file mode 100644 index 4b24efc1112..00000000000 --- a/tests/misc/cs/projects/Issue4116/.gitignore +++ /dev/null @@ -1 +0,0 @@ -/cs diff --git a/tests/misc/cs/projects/Issue4116/base/A.hx b/tests/misc/cs/projects/Issue4116/base/A.hx deleted file mode 100644 index 5d16aa95a66..00000000000 --- a/tests/misc/cs/projects/Issue4116/base/A.hx +++ /dev/null @@ -1,3 +0,0 @@ -package base; - -class A {} \ No newline at end of file diff --git a/tests/misc/cs/projects/Issue4116/compile.hxml b/tests/misc/cs/projects/Issue4116/compile.hxml deleted file mode 100644 index 5549dd9fd2f..00000000000 --- a/tests/misc/cs/projects/Issue4116/compile.hxml +++ /dev/null @@ -1,2 +0,0 @@ --cs cs -base.A diff --git a/tests/misc/cs/projects/Issue4598/Main.hx b/tests/misc/cs/projects/Issue4598/Main.hx deleted file mode 100644 index f10358990a0..00000000000 --- a/tests/misc/cs/projects/Issue4598/Main.hx +++ /dev/null @@ -1,16 +0,0 @@ -class Main { - @:readOnly - public var a:Int = 10; - - static function main() { - var m = new Main(); - - try Reflect.setProperty(m, 'a', 999) - catch(e:cs.system.MemberAccessException) {} - if(m.a != 10) { - throw "Main.a should not be writable via reflection"; - } - } - - public function new() {} -} \ No newline at end of file diff --git a/tests/misc/cs/projects/Issue4598/Run.hx b/tests/misc/cs/projects/Issue4598/Run.hx deleted file mode 100644 index bae758e08d9..00000000000 --- a/tests/misc/cs/projects/Issue4598/Run.hx +++ /dev/null @@ -1,11 +0,0 @@ -class Run { - static public function run() { - var exitCode = switch (Sys.systemName()) { - case 'Windows': - Sys.command('bin\\bin\\Main.exe'); - case _: - Sys.command('mono', ['bin/bin/Main.exe']); - } - Sys.exit(exitCode); - } -} \ No newline at end of file diff --git a/tests/misc/cs/projects/Issue4598/compile.hxml b/tests/misc/cs/projects/Issue4598/compile.hxml deleted file mode 100644 index 357e86022cf..00000000000 --- a/tests/misc/cs/projects/Issue4598/compile.hxml +++ /dev/null @@ -1,4 +0,0 @@ --cs bin --main Main ---next ---macro Run.run() \ No newline at end of file diff --git a/tests/misc/cs/projects/Issue4623/Main.hx b/tests/misc/cs/projects/Issue4623/Main.hx deleted file mode 100644 index 0b763c40f1a..00000000000 --- a/tests/misc/cs/projects/Issue4623/Main.hx +++ /dev/null @@ -1,59 +0,0 @@ -@:nativeGen -class Main { - static var voidResult:String; - - static function testVoid(a:Int, b:String = 'hello', ?c:String):Void { - voidResult = '$a $b $c'; - } - - static function test(a:Int, b:String = 'hello', ?c:String):String { - return '$a $b $c'; - } - - public static function main() { - untyped __cs__('global::Main.testVoid(1, "foo")'); - var expected = '1 foo null'; - if(voidResult != expected) { - throw 'Invalid result of testVoid(1, "foo"). Expected: $expected. Got: $voidResult'; - } - - untyped __cs__('global::Main.testVoid(2)'); - var expected = '2 hello null'; - if(voidResult != expected) { - throw 'Invalid result of testVoid(2). Expected: $expected. Got: $voidResult'; - } - - var expected = '3 bar null'; - var result = untyped __cs__('global::Main.test(3, "bar")'); - if(expected != result) { - throw 'Invalid result of test(3, "bar"). Expected: $expected. Got: $result'; - } - - var expected = '4 hello null'; - var result = untyped __cs__('global::Main.test(4)'); - if(expected != result) { - throw 'Invalid result of test(4). Expected: $expected. Got: $result'; - } - - var n:CtorTest = untyped __cs__('new global::CtorTest(20);') ; - if(n.a != 20 || n.b != 'hello') { - throw 'Invalid result of new CtorTest(20)'; - } - - var n:CtorTest = untyped __cs__('new global::CtorTest();') ; - if(n.a != 10 || n.b != 'hello') { - throw 'Invalid result of new CtorTest()'; - } - } -} - -@:nativeGen -class CtorTest { - public var a:Int; - public var b:String; - - public function new(a:Int = 10, b:String = 'hello') { - this.a = a; - this.b = b; - } -} \ No newline at end of file diff --git a/tests/misc/cs/projects/Issue4623/Run.hx b/tests/misc/cs/projects/Issue4623/Run.hx deleted file mode 100644 index bae758e08d9..00000000000 --- a/tests/misc/cs/projects/Issue4623/Run.hx +++ /dev/null @@ -1,11 +0,0 @@ -class Run { - static public function run() { - var exitCode = switch (Sys.systemName()) { - case 'Windows': - Sys.command('bin\\bin\\Main.exe'); - case _: - Sys.command('mono', ['bin/bin/Main.exe']); - } - Sys.exit(exitCode); - } -} \ No newline at end of file diff --git a/tests/misc/cs/projects/Issue4623/compile.hxml b/tests/misc/cs/projects/Issue4623/compile.hxml deleted file mode 100644 index 357e86022cf..00000000000 --- a/tests/misc/cs/projects/Issue4623/compile.hxml +++ /dev/null @@ -1,4 +0,0 @@ --cs bin --main Main ---next ---macro Run.run() \ No newline at end of file diff --git a/tests/misc/cs/projects/Issue5434/Main.hx b/tests/misc/cs/projects/Issue5434/Main.hx deleted file mode 100644 index bca478825cc..00000000000 --- a/tests/misc/cs/projects/Issue5434/Main.hx +++ /dev/null @@ -1,6 +0,0 @@ -interface ITest { - function keys():Array; - function values():Array; -} - -interface ISubTest extends ITest {} diff --git a/tests/misc/cs/projects/Issue5434/compile.hxml b/tests/misc/cs/projects/Issue5434/compile.hxml deleted file mode 100644 index 62d1ab5ddc1..00000000000 --- a/tests/misc/cs/projects/Issue5434/compile.hxml +++ /dev/null @@ -1,2 +0,0 @@ -Main --cs bin diff --git a/tests/misc/cs/projects/Issue5915/Test.hx b/tests/misc/cs/projects/Issue5915/Test.hx deleted file mode 100644 index 99ac197e1d5..00000000000 --- a/tests/misc/cs/projects/Issue5915/Test.hx +++ /dev/null @@ -1,20 +0,0 @@ -enum A { - A1(v:String); - A2(v:B); -} -enum B { - BB(v:Float); -} -class Test { - public static function main () { - var v1 = A2(BB(12)); - v1 = switch (v1) { - case A2(v): - switch (v) { - case BB(v): A2(BB(v++)); - } - default: A1(""); - } - trace(v1); - } -} \ No newline at end of file diff --git a/tests/misc/cs/projects/Issue5915/compile.hxml b/tests/misc/cs/projects/Issue5915/compile.hxml deleted file mode 100644 index 4f946ed5ac0..00000000000 --- a/tests/misc/cs/projects/Issue5915/compile.hxml +++ /dev/null @@ -1,2 +0,0 @@ --main Test --cs bin diff --git a/tests/misc/cs/projects/Issue5953/Main.hx b/tests/misc/cs/projects/Issue5953/Main.hx deleted file mode 100644 index 60d63f642b0..00000000000 --- a/tests/misc/cs/projects/Issue5953/Main.hx +++ /dev/null @@ -1,17 +0,0 @@ -class Main { - static function main() { - var map = foo(null); - trace(map); - } - - static function foo(m:NativeStringMap) - return m.toMap(); -} - -abstract NativeStringMap(Impl) { - @:to public function toMap():Map { - return new Map(); - } -} - -typedef Impl = cs.system.collections.generic.IDictionary_2; diff --git a/tests/misc/cs/projects/Issue5953/Reduced.hx b/tests/misc/cs/projects/Issue5953/Reduced.hx deleted file mode 100644 index 94888767e62..00000000000 --- a/tests/misc/cs/projects/Issue5953/Reduced.hx +++ /dev/null @@ -1,10 +0,0 @@ -@:nativeGen -class C {} - -class C2 {} - -abstract A(C) { - function f():C2 return null; - - static function foo(a:A) return a.f(); -} diff --git a/tests/misc/cs/projects/Issue5953/compile.hxml b/tests/misc/cs/projects/Issue5953/compile.hxml deleted file mode 100644 index 284745cdd01..00000000000 --- a/tests/misc/cs/projects/Issue5953/compile.hxml +++ /dev/null @@ -1,3 +0,0 @@ --main Main -Reduced --cs bin diff --git a/tests/misc/cs/projects/Issue6635/Main.hx b/tests/misc/cs/projects/Issue6635/Main.hx deleted file mode 100644 index 27458b4b6f4..00000000000 --- a/tests/misc/cs/projects/Issue6635/Main.hx +++ /dev/null @@ -1,13 +0,0 @@ -abstract A(String) {} - -typedef S = {a:A}; - -class Main { - function new(s:S) {} - - static function getS():S return null; - - static function main() { - new Main(getS()); - } -} \ No newline at end of file diff --git a/tests/misc/cs/projects/Issue6635/compile.hxml b/tests/misc/cs/projects/Issue6635/compile.hxml deleted file mode 100644 index 57033c162aa..00000000000 --- a/tests/misc/cs/projects/Issue6635/compile.hxml +++ /dev/null @@ -1,3 +0,0 @@ --main Main --cs bin --D no-compilation \ No newline at end of file diff --git a/tests/misc/cs/projects/Issue6635/compile.hxml.stderr b/tests/misc/cs/projects/Issue6635/compile.hxml.stderr deleted file mode 100644 index e69de29bb2d..00000000000 diff --git a/tests/misc/cs/projects/Issue7875/Main.hx b/tests/misc/cs/projects/Issue7875/Main.hx deleted file mode 100644 index 5cb3d3a418f..00000000000 --- a/tests/misc/cs/projects/Issue7875/Main.hx +++ /dev/null @@ -1,23 +0,0 @@ -import cs.system.WeakReference_1; - -class Main { - public static function main() { - new Test(new A()); - } -} - -@:nativeGen -class Test { - public function new(a:T) { - test(function() return new WeakReference_1(a)); - } - - function test(cb:()->WeakReference_1):Void {} - - -} - -class A { - public function new() {} -} - diff --git a/tests/misc/cs/projects/Issue7875/compile.hxml b/tests/misc/cs/projects/Issue7875/compile.hxml deleted file mode 100644 index 9f9209b7ba8..00000000000 --- a/tests/misc/cs/projects/Issue7875/compile.hxml +++ /dev/null @@ -1,3 +0,0 @@ ---main Main --cs bin --D net-ver=45 diff --git a/tests/misc/cs/projects/Issue8347/.gitignore b/tests/misc/cs/projects/Issue8347/.gitignore deleted file mode 100644 index 43579b9ceac..00000000000 --- a/tests/misc/cs/projects/Issue8347/.gitignore +++ /dev/null @@ -1,2 +0,0 @@ -cs -cs-fail diff --git a/tests/misc/cs/projects/Issue8347/Main.hx b/tests/misc/cs/projects/Issue8347/Main.hx deleted file mode 100644 index ce97ed29781..00000000000 --- a/tests/misc/cs/projects/Issue8347/Main.hx +++ /dev/null @@ -1,7 +0,0 @@ -import cs.system.reflection.AssemblyDelaySignAttribute; - -@:cs.assemblyMeta(Test) -class Main {} - -@:cs.assemblyStrict(cs.system.reflection.AssemblyDelaySignAttribute(true)) -class Main2 {} diff --git a/tests/misc/cs/projects/Issue8347/compile-fail.hxml b/tests/misc/cs/projects/Issue8347/compile-fail.hxml deleted file mode 100644 index 0201ad45c7a..00000000000 --- a/tests/misc/cs/projects/Issue8347/compile-fail.hxml +++ /dev/null @@ -1,5 +0,0 @@ --cp src -Main -fail.NotFirstType --cs cs-fail --D no-compilation diff --git a/tests/misc/cs/projects/Issue8347/compile-fail.hxml.stderr b/tests/misc/cs/projects/Issue8347/compile-fail.hxml.stderr deleted file mode 100644 index 7a807b3e17e..00000000000 --- a/tests/misc/cs/projects/Issue8347/compile-fail.hxml.stderr +++ /dev/null @@ -1,4 +0,0 @@ -src/fail/NotFirstType.hx:8: characters 1-22 : @:cs.assemblyStrict can only be used on the first class of a module -Main.hx:4: characters 1-14 : @:cs.assemblyMeta cannot be used on top level modules -Main.hx:7: characters 1-15 : @:cs.assemblyStrict can only be used on the first class of a module -Main.hx:7: characters 1-15 : @:cs.assemblyStrict cannot be used on top level modules diff --git a/tests/misc/cs/projects/Issue8347/compile.hxml b/tests/misc/cs/projects/Issue8347/compile.hxml deleted file mode 100644 index 11bc490c1a1..00000000000 --- a/tests/misc/cs/projects/Issue8347/compile.hxml +++ /dev/null @@ -1,3 +0,0 @@ --cp src -pack.Main --cs bin diff --git a/tests/misc/cs/projects/Issue8347/src/fail/NotFirstType.hx b/tests/misc/cs/projects/Issue8347/src/fail/NotFirstType.hx deleted file mode 100644 index 00bf05b61d4..00000000000 --- a/tests/misc/cs/projects/Issue8347/src/fail/NotFirstType.hx +++ /dev/null @@ -1,9 +0,0 @@ -package fail; - -import cs.system.reflection.AssemblyDelaySignAttribute; - -enum SomeEnum {} - -@:cs.assemblyStrict(cs.system.reflection.AssemblyDelaySignAttribute(true)) -class NotFirstType {} - diff --git a/tests/misc/cs/projects/Issue8347/src/pack/Main.hx b/tests/misc/cs/projects/Issue8347/src/pack/Main.hx deleted file mode 100644 index 87173d8dc17..00000000000 --- a/tests/misc/cs/projects/Issue8347/src/pack/Main.hx +++ /dev/null @@ -1,7 +0,0 @@ -package pack; - -import cs.system.reflection.AssemblyDelaySignAttribute; - -@:cs.assemblyMeta(System.Reflection.AssemblyDefaultAliasAttribute("test")) -@:cs.assemblyStrict(cs.system.reflection.AssemblyDelaySignAttribute(true)) -class Main {} diff --git a/tests/misc/cs/projects/Issue8361/Main.hx b/tests/misc/cs/projects/Issue8361/Main.hx deleted file mode 100644 index 29174479e76..00000000000 --- a/tests/misc/cs/projects/Issue8361/Main.hx +++ /dev/null @@ -1,22 +0,0 @@ -class SortedStringMapImpl extends haxe.ds.BalancedTree implements haxe.Constraints.IMap { - - var cmp:String -> String -> Int; - - public function new(?comparator:String -> String -> Int) { - super(); - this.cmp = comparator == null ? haxe.Utf8.compare : comparator; - } - - override - function compare(s1:String, s2:String):Int { - return cmp(s1, s2); - } -} - -class Main { - static function main() { - var m = new SortedStringMapImpl(); - m.set("foo", "bar"); - trace(m); - } -} diff --git a/tests/misc/cs/projects/Issue8361/compile.hxml b/tests/misc/cs/projects/Issue8361/compile.hxml deleted file mode 100644 index 144577b504c..00000000000 --- a/tests/misc/cs/projects/Issue8361/compile.hxml +++ /dev/null @@ -1,2 +0,0 @@ --main Main --cs bin diff --git a/tests/misc/cs/projects/Issue8366/Main.hx b/tests/misc/cs/projects/Issue8366/Main.hx deleted file mode 100644 index ff7b07d78b4..00000000000 --- a/tests/misc/cs/projects/Issue8366/Main.hx +++ /dev/null @@ -1,22 +0,0 @@ -class Main { - public static function main() { - var x:cs.NativeArray = new cs.NativeArray(1); - - cs.Lib.unsafe({trace(42);}); - cs.Lib.unsafe(trace(42)); - - cs.Lib.unsafe({ - cs.Lib.fixed({ - var addr = cs.Lib.pointerOfArray(x); - trace(cs.Lib.valueOf(addr)); //0 - addr[0] = 42; - trace(cs.Lib.valueOf(addr)); //42 - }); - }); - } - - @:unsafe static function unsafeFunction() {} -} - -@:unsafe -class TestUnsafe {} diff --git a/tests/misc/cs/projects/Issue8366/compile.hxml b/tests/misc/cs/projects/Issue8366/compile.hxml deleted file mode 100644 index 5e2d6e17215..00000000000 --- a/tests/misc/cs/projects/Issue8366/compile.hxml +++ /dev/null @@ -1,3 +0,0 @@ --cs bin --D unsafe --main Main diff --git a/tests/misc/cs/projects/Issue8487/Main1.hx b/tests/misc/cs/projects/Issue8487/Main1.hx deleted file mode 100644 index 6b5473fa5ac..00000000000 --- a/tests/misc/cs/projects/Issue8487/Main1.hx +++ /dev/null @@ -1,6 +0,0 @@ -@:cs.using("System") -class Main1 { - public static function main():Void { - trace('ok'); - } -} diff --git a/tests/misc/cs/projects/Issue8487/Main2.hx b/tests/misc/cs/projects/Issue8487/Main2.hx deleted file mode 100644 index e35077279f2..00000000000 --- a/tests/misc/cs/projects/Issue8487/Main2.hx +++ /dev/null @@ -1,8 +0,0 @@ -interface I {} - -@:cs.using("System") -class Main2 { - public static function main():Void { - trace('ko'); - } -} diff --git a/tests/misc/cs/projects/Issue8487/compile-fail.hxml b/tests/misc/cs/projects/Issue8487/compile-fail.hxml deleted file mode 100644 index dc8ec7d9a8f..00000000000 --- a/tests/misc/cs/projects/Issue8487/compile-fail.hxml +++ /dev/null @@ -1,2 +0,0 @@ --cs bin --main Main2 diff --git a/tests/misc/cs/projects/Issue8487/compile-fail.hxml.stderr b/tests/misc/cs/projects/Issue8487/compile-fail.hxml.stderr deleted file mode 100644 index 5f8cb28eb46..00000000000 --- a/tests/misc/cs/projects/Issue8487/compile-fail.hxml.stderr +++ /dev/null @@ -1 +0,0 @@ -Main2.hx:3: characters 1-11 : @:cs.using can only be used on the first type of a module diff --git a/tests/misc/cs/projects/Issue8487/compile.hxml b/tests/misc/cs/projects/Issue8487/compile.hxml deleted file mode 100644 index fd2c2f07b6c..00000000000 --- a/tests/misc/cs/projects/Issue8487/compile.hxml +++ /dev/null @@ -1,2 +0,0 @@ --cs bin --main Main1 diff --git a/tests/misc/cs/projects/Issue8589/Main.hx b/tests/misc/cs/projects/Issue8589/Main.hx deleted file mode 100644 index 300211779c8..00000000000 --- a/tests/misc/cs/projects/Issue8589/Main.hx +++ /dev/null @@ -1,10 +0,0 @@ -import cs.system.collections.generic.List_1; - -typedef T = {id:String}; - -class Main { - public static function main() { - var list:List_1 = new List_1(); - list.ConvertAll((t:T) -> t.id); - } -} \ No newline at end of file diff --git a/tests/misc/cs/projects/Issue8589/compile.hxml b/tests/misc/cs/projects/Issue8589/compile.hxml deleted file mode 100644 index 57033c162aa..00000000000 --- a/tests/misc/cs/projects/Issue8589/compile.hxml +++ /dev/null @@ -1,3 +0,0 @@ --main Main --cs bin --D no-compilation \ No newline at end of file diff --git a/tests/misc/cs/projects/Issue8589/compile.hxml.stderr b/tests/misc/cs/projects/Issue8589/compile.hxml.stderr deleted file mode 100644 index e69de29bb2d..00000000000 diff --git a/tests/misc/cs/projects/Issue8664/Main.hx b/tests/misc/cs/projects/Issue8664/Main.hx deleted file mode 100644 index 8a862bbaa82..00000000000 --- a/tests/misc/cs/projects/Issue8664/Main.hx +++ /dev/null @@ -1,25 +0,0 @@ -import cs.NativeArray; - -class Main { - public static function main() { - new Arr().map(function(v) return Std.parseInt(v)); - } -} - -class Arr { - var __a:NativeArray; - - public function new() {} - - public inline function map(f:T->S) { - new Arr().__unsafe_set(f(__unsafe_get())); - } - - inline function __unsafe_get():T { - return __a[0]; - } - - inline function __unsafe_set(val:T):T { - return __a[0] = val; - } -} \ No newline at end of file diff --git a/tests/misc/cs/projects/Issue8664/compile.hxml b/tests/misc/cs/projects/Issue8664/compile.hxml deleted file mode 100644 index 144577b504c..00000000000 --- a/tests/misc/cs/projects/Issue8664/compile.hxml +++ /dev/null @@ -1,2 +0,0 @@ --main Main --cs bin diff --git a/tests/misc/cs/projects/Issue9799/Main.hx b/tests/misc/cs/projects/Issue9799/Main.hx deleted file mode 100644 index 4a53a31400c..00000000000 --- a/tests/misc/cs/projects/Issue9799/Main.hx +++ /dev/null @@ -1,23 +0,0 @@ -import haxe.Constraints.Constructible; - -@:generic -class TestVoid>> { - - var sleepAmount:Float = 0; - - public function new() { - var fn = function() { - Sys.sleep(this.sleepAmount); - } - } -} - -class BoringClass { - public function new() { } -} - -class Main { - static function main() { - new Test(); - } -} \ No newline at end of file diff --git a/tests/misc/cs/projects/Issue9799/compile.hxml b/tests/misc/cs/projects/Issue9799/compile.hxml deleted file mode 100644 index 144577b504c..00000000000 --- a/tests/misc/cs/projects/Issue9799/compile.hxml +++ /dev/null @@ -1,2 +0,0 @@ --main Main --cs bin diff --git a/tests/misc/cs/run.hxml b/tests/misc/cs/run.hxml deleted file mode 100644 index b72a6e8015f..00000000000 --- a/tests/misc/cs/run.hxml +++ /dev/null @@ -1,2 +0,0 @@ --cp ../src ---run Main \ No newline at end of file diff --git a/tests/misc/eventLoop/all.hxml b/tests/misc/eventLoop/all.hxml index fce314c4c13..45a02f16730 100644 --- a/tests/misc/eventLoop/all.hxml +++ b/tests/misc/eventLoop/all.hxml @@ -12,8 +12,6 @@ --next -php php --next --java java ---next --cs cs +-jvm java.jar --next -cpp cpp diff --git a/tests/misc/java/projects/Issue11095/compile-fail.hxml b/tests/misc/java/projects/Issue11095/compile-fail.hxml index 295920d4e80..98aa6a185f3 100644 --- a/tests/misc/java/projects/Issue11095/compile-fail.hxml +++ b/tests/misc/java/projects/Issue11095/compile-fail.hxml @@ -6,4 +6,4 @@ NoRudy --main Main --java-lib no-rudy.jar ---java run.jar \ No newline at end of file +--jvm run.jar diff --git a/tests/misc/java/projects/Issue2689/compile-fail.hxml b/tests/misc/java/projects/Issue2689/compile-fail.hxml index 81ccea9793f..4951754851a 100644 --- a/tests/misc/java/projects/Issue2689/compile-fail.hxml +++ b/tests/misc/java/projects/Issue2689/compile-fail.hxml @@ -1,3 +1,3 @@ -main Main --java bin ---no-output \ No newline at end of file +-jvm bin/out.jar +--no-output diff --git a/tests/misc/java/projects/Issue8322/Main.hx b/tests/misc/java/projects/Issue8322/Main.hx deleted file mode 100644 index 479c0fcd5b7..00000000000 --- a/tests/misc/java/projects/Issue8322/Main.hx +++ /dev/null @@ -1,7 +0,0 @@ -import haxe.CallStack; - -class Main { - static function main() { - CallStack.exceptionStack(); - } -} \ No newline at end of file diff --git a/tests/misc/java/projects/Issue8322/compile.hxml b/tests/misc/java/projects/Issue8322/compile.hxml deleted file mode 100644 index 603475c8b8b..00000000000 --- a/tests/misc/java/projects/Issue8322/compile.hxml +++ /dev/null @@ -1,3 +0,0 @@ --main Main --java bin --cmd java -jar bin/Main.jar \ No newline at end of file diff --git a/tests/misc/java/projects/Issue8444/compile.hxml b/tests/misc/java/projects/Issue8444/compile.hxml index a613a8c0693..285b53556d8 100644 --- a/tests/misc/java/projects/Issue8444/compile.hxml +++ b/tests/misc/java/projects/Issue8444/compile.hxml @@ -1,3 +1,3 @@ -main Main --java bin +--jvm bin/bin.jvm -D no-compilation \ No newline at end of file diff --git a/tests/misc/java/projects/Issue9799/compile.hxml b/tests/misc/java/projects/Issue9799/compile.hxml index 11b4cabd616..7655c321ca9 100644 --- a/tests/misc/java/projects/Issue9799/compile.hxml +++ b/tests/misc/java/projects/Issue9799/compile.hxml @@ -1,2 +1,2 @@ -main Main --java bin +--jvm bin/jvm.jar 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 new file mode 100644 index 00000000000..556609ee8a5 --- /dev/null +++ b/tests/misc/projects/Issue10844/user-defined-meta-json-pretty-fail.hxml.stderr @@ -0,0 +1,12 @@ +[ERROR] --macro haxe.macro.Compiler.registerMetadataDescriptionFile('meta.jsno', 'myapp') + + | Uncaught exception Could not read file meta.jsno + + -> $$normPath(::std::)/haxe/macro/Compiler.hx:486: characters 11-39 + + 486 | var f = sys.io.File.getContent(path); + | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + | Called from here + + | Called from here + diff --git a/tests/misc/projects/Issue10871/Compiler/compile1.hxml.stdout b/tests/misc/projects/Issue10871/Compiler/compile1.hxml.stdout index af10cb1caf1..17249ad6223 100644 --- a/tests/misc/projects/Issue10871/Compiler/compile1.hxml.stdout +++ b/tests/misc/projects/Issue10871/Compiler/compile1.hxml.stdout @@ -14,5 +14,4 @@ Main.hx:26: js is forbidden Main.hx:26: java is forbidden Main.hx:26: hl is forbidden Main.hx:26: flash is forbidden -Main.hx:26: cs is forbidden Main.hx:26: cpp is forbidden \ No newline at end of file diff --git a/tests/misc/projects/Issue10871/Compiler/compile2.hxml.stdout b/tests/misc/projects/Issue10871/Compiler/compile2.hxml.stdout index 3b471bd6244..817a9b23002 100644 --- a/tests/misc/projects/Issue10871/Compiler/compile2.hxml.stdout +++ b/tests/misc/projects/Issue10871/Compiler/compile2.hxml.stdout @@ -15,5 +15,4 @@ Main.hx:26: java is forbidden Main.hx:26: hl is forbidden Main.hx:26: flash is forbidden Main.hx:26: eval is forbidden -Main.hx:26: cs is forbidden Main.hx:26: cpp is forbidden \ No newline at end of file diff --git a/tests/misc/projects/Issue10871/Compiler/compile3.hxml.stdout b/tests/misc/projects/Issue10871/Compiler/compile3.hxml.stdout index ac231cbad5b..aeb7c87f1c8 100644 --- a/tests/misc/projects/Issue10871/Compiler/compile3.hxml.stdout +++ b/tests/misc/projects/Issue10871/Compiler/compile3.hxml.stdout @@ -14,5 +14,4 @@ Main.hx:26: js is forbidden Main.hx:26: java is forbidden Main.hx:26: hl is forbidden Main.hx:26: flash is forbidden -Main.hx:26: eval is forbidden -Main.hx:26: cs is forbidden \ No newline at end of file +Main.hx:26: eval is forbidden \ No newline at end of file diff --git a/tests/misc/projects/Issue5002/Macro.hx b/tests/misc/projects/issue5002/Macro.hx similarity index 100% rename from tests/misc/projects/Issue5002/Macro.hx rename to tests/misc/projects/issue5002/Macro.hx diff --git a/tests/misc/projects/Issue5002/Main.hx b/tests/misc/projects/issue5002/Main.hx similarity index 100% rename from tests/misc/projects/Issue5002/Main.hx rename to tests/misc/projects/issue5002/Main.hx diff --git a/tests/misc/projects/Issue5002/Main2.hx b/tests/misc/projects/issue5002/Main2.hx similarity index 100% rename from tests/misc/projects/Issue5002/Main2.hx rename to tests/misc/projects/issue5002/Main2.hx diff --git a/tests/misc/projects/Issue5002/Main3.hx b/tests/misc/projects/issue5002/Main3.hx similarity index 100% rename from tests/misc/projects/Issue5002/Main3.hx rename to tests/misc/projects/issue5002/Main3.hx diff --git a/tests/misc/projects/Issue5002/Main4.hx b/tests/misc/projects/issue5002/Main4.hx similarity index 100% rename from tests/misc/projects/Issue5002/Main4.hx rename to tests/misc/projects/issue5002/Main4.hx diff --git a/tests/misc/projects/Issue5002/compile-fail.hxml b/tests/misc/projects/issue5002/compile-fail.hxml similarity index 100% rename from tests/misc/projects/Issue5002/compile-fail.hxml rename to tests/misc/projects/issue5002/compile-fail.hxml diff --git a/tests/misc/projects/Issue5002/compile-fail.hxml.stderr b/tests/misc/projects/issue5002/compile-fail.hxml.stderr similarity index 100% rename from tests/misc/projects/Issue5002/compile-fail.hxml.stderr rename to tests/misc/projects/issue5002/compile-fail.hxml.stderr diff --git a/tests/misc/projects/Issue5002/compile2-fail.hxml b/tests/misc/projects/issue5002/compile2-fail.hxml similarity index 100% rename from tests/misc/projects/Issue5002/compile2-fail.hxml rename to tests/misc/projects/issue5002/compile2-fail.hxml diff --git a/tests/misc/projects/Issue5002/compile2-fail.hxml.stderr b/tests/misc/projects/issue5002/compile2-fail.hxml.stderr similarity index 100% rename from tests/misc/projects/Issue5002/compile2-fail.hxml.stderr rename to tests/misc/projects/issue5002/compile2-fail.hxml.stderr diff --git a/tests/misc/projects/Issue5002/compile3-fail.hxml b/tests/misc/projects/issue5002/compile3-fail.hxml similarity index 100% rename from tests/misc/projects/Issue5002/compile3-fail.hxml rename to tests/misc/projects/issue5002/compile3-fail.hxml diff --git a/tests/misc/projects/Issue5002/compile3-fail.hxml.stderr b/tests/misc/projects/issue5002/compile3-fail.hxml.stderr similarity index 100% rename from tests/misc/projects/Issue5002/compile3-fail.hxml.stderr rename to tests/misc/projects/issue5002/compile3-fail.hxml.stderr diff --git a/tests/misc/projects/Issue5002/compile4-fail.hxml b/tests/misc/projects/issue5002/compile4-fail.hxml similarity index 100% rename from tests/misc/projects/Issue5002/compile4-fail.hxml rename to tests/misc/projects/issue5002/compile4-fail.hxml diff --git a/tests/misc/projects/Issue5002/compile4-fail.hxml.stderr b/tests/misc/projects/issue5002/compile4-fail.hxml.stderr similarity index 100% rename from tests/misc/projects/Issue5002/compile4-fail.hxml.stderr rename to tests/misc/projects/issue5002/compile4-fail.hxml.stderr diff --git a/tests/misc/weakmap/compile-cs.hxml b/tests/misc/weakmap/compile-cs.hxml deleted file mode 100644 index 5bb7d71bae9..00000000000 --- a/tests/misc/weakmap/compile-cs.hxml +++ /dev/null @@ -1,3 +0,0 @@ ---main TestWeakMap --cs cs ---debug diff --git a/tests/misc/weakmap/compile-java.hxml b/tests/misc/weakmap/compile-java.hxml index f1f3a6cfdb9..63e32cb2be4 100644 --- a/tests/misc/weakmap/compile-java.hxml +++ b/tests/misc/weakmap/compile-java.hxml @@ -1,2 +1,2 @@ --main TestWeakMap --java java +-jvm java.jar diff --git a/tests/runci/TestTarget.hx b/tests/runci/TestTarget.hx index ba33266a854..a475e3191ba 100644 --- a/tests/runci/TestTarget.hx +++ b/tests/runci/TestTarget.hx @@ -9,9 +9,7 @@ enum abstract TestTarget(String) from String { var Cpp = "cpp"; var Cppia = "cppia"; var Flash = "flash"; - var Java = "java"; var Jvm = "jvm"; - var Cs = "cs"; var Python = "python"; var Hl = "hl"; } diff --git a/tests/runci/targets/Cs.hx b/tests/runci/targets/Cs.hx deleted file mode 100644 index a2879cf6a06..00000000000 --- a/tests/runci/targets/Cs.hx +++ /dev/null @@ -1,84 +0,0 @@ -package runci.targets; - -import sys.FileSystem; -import runci.System.*; -import runci.Config.*; - -class Cs { - static final miscCsDir = getMiscSubDir('cs'); - - static public function getCsDependencies() { - switch (systemName) { - case "Linux": - if (!isCi() && commandSucceed("mono", ["--version"])) - infoMsg('mono has already been installed.'); - else - Linux.requireAptPackages(["mono-devel", "mono-mcs"]); - runCommand("mono", ["--version"]); - case "Mac": - if (commandSucceed("mono", ["--version"])) - infoMsg('mono has already been installed.'); - else - runNetworkCommand("brew", ["install", "mono"]); - runCommand("mono", ["--version"]); - case "Windows": - //pass - } - - haxelibInstallGit("HaxeFoundation", "hxcs", true); - } - - static public function runCs(exe:String, ?args:Array):Void { - if (args == null) args = []; - exe = FileSystem.fullPath(exe); - switch (systemName) { - case "Linux" | "Mac": - runCommand("mono", [exe].concat(args)); - case "Windows": - runCommand(exe, args); - } - } - - static public function run(args:Array) { - getCsDependencies(); - - for (fastcast in [[], ["-D", "fast_cast"]]) - for (noroot in [[], ["-D", "no_root"]]) - for (erasegenerics in [[], ["-D", "erase_generics"]]) - { - final extras = fastcast.concat(erasegenerics).concat(noroot); - runCommand("haxe", ['compile-cs.hxml'].concat(extras).concat(args)); - runCs("bin/cs/bin/TestMain-Debug.exe"); - - runCommand("haxe", ['compile-cs-unsafe.hxml'].concat(extras).concat(args)); - runCs("bin/cs_unsafe/bin/TestMain-Debug.exe"); - } - - runCommand("haxe", ['compile-cs.hxml','-dce','no'].concat(args)); - runCs("bin/cs/bin/TestMain-Debug.exe"); - - changeDirectory(sysDir); - runCommand("haxe", ["compile-cs.hxml",'-D','fast_cast'].concat(args)); - final exe = FileSystem.fullPath("bin/cs/bin/Main-Debug.exe"); - switch (systemName) { - case "Windows": - runSysTest(exe); - case _: - runSysTest("mono", [exe]); - } - - changeDirectory(threadsDir); - runCommand("haxe", ["build.hxml", "-cs", "export/cs"]); - runCs("export/cs/bin/Main.exe"); - - changeDirectory(miscCsDir); - runCommand("haxe", ["run.hxml"]); - - changeDirectory(getMiscSubDir("cs", "csTwoLibs")); - for (i in 1...5) - { - runCommand("haxe", ['compile-$i.hxml','-D','fast_cast']); - runCs("bin/main/bin/Main.exe"); - } - } -} diff --git a/tests/runci/targets/Java.hx b/tests/runci/targets/Java.hx deleted file mode 100644 index c5d542b29a9..00000000000 --- a/tests/runci/targets/Java.hx +++ /dev/null @@ -1,48 +0,0 @@ -package runci.targets; - -import sys.FileSystem; -import haxe.io.Path; -import runci.System.*; -import runci.Config.*; -using StringTools; - -class Java { - static public function getJavaDependencies() { - haxelibInstallGit("HaxeFoundation", "hxjava", true); - haxelibInstallGit("HaxeFoundation", "format", "jvm", "--always"); - runCommand("javac", ["-version"]); - } - - static public function run(args:Array) { - deleteDirectoryRecursively("bin/java"); - getJavaDependencies(); - - runCommand("haxe", ["compile-java.hxml"].concat(args)); - runCommand("java", ["-jar", "bin/java/TestMain-Debug.jar"]); - - runCommand("haxe", ["compile-java.hxml","-dce","no"].concat(args)); - runCommand("java", ["-jar", "bin/java/TestMain-Debug.jar"]); - - changeDirectory(sysDir); - runCommand("haxe", ["compile-java.hxml"].concat(args)); - runSysTest("java", ["-jar", "bin/java/Main-Debug.jar"]); - - changeDirectory(threadsDir); - runCommand("haxe", ["build.hxml", "-java", "export/java"].concat(args)); - runCommand("java", ["-jar", "export/java/Main.jar"]); - - infoMsg("Testing java-lib extras"); - changeDirectory(Path.join([unitDir, 'bin'])); - final libTestDir = 'java-lib-tests'; - if (!FileSystem.exists(libTestDir)) - runNetworkCommand("git", ["clone", "https://github.com/waneck/java-lib-tests.git", "--depth", "1"]); - - for (dir in FileSystem.readDirectory(libTestDir)) { - final path = Path.join([libTestDir, dir]); - if (FileSystem.isDirectory(path)) - for (file in FileSystem.readDirectory(path)) - if (file.endsWith('.hxml')) - runCommand("haxe", ["--cwd", path, file]); - } - } -} diff --git a/tests/runci/targets/Js.hx b/tests/runci/targets/Js.hx index 33de3b782fc..575422ffe5d 100644 --- a/tests/runci/targets/Js.hx +++ b/tests/runci/targets/Js.hx @@ -121,7 +121,7 @@ class Js { changeDirectory(optDir); runCommand("haxe", ["run.hxml"]); - runci.targets.Java.getJavaDependencies(); // this is awkward + runci.targets.Jvm.getJavaDependencies(); // this is awkward haxelibInstallGit("Simn", "haxeserver"); changeDirectory(serverDir); runCommand("haxe", ["build.hxml"]); diff --git a/tests/runci/targets/Jvm.hx b/tests/runci/targets/Jvm.hx index f471cab845e..706ef113ee1 100644 --- a/tests/runci/targets/Jvm.hx +++ b/tests/runci/targets/Jvm.hx @@ -4,11 +4,17 @@ import runci.System.*; import runci.Config.*; class Jvm { + static public function getJavaDependencies() { + haxelibInstallGit("HaxeFoundation", "hxjava", true); + haxelibInstallGit("HaxeFoundation", "format", "jvm", "--always"); + runCommand("javac", ["-version"]); + } + static final miscJavaDir = getMiscSubDir('java'); static public function run(args:Array) { deleteDirectoryRecursively("bin/jvm"); - Java.getJavaDependencies(); + getJavaDependencies(); runCommand("haxe", ["compile-java-native.hxml"]); diff --git a/tests/server/src/cases/ServerTests.hx b/tests/server/src/cases/ServerTests.hx index 9833e8ee929..3de168c9790 100644 --- a/tests/server/src/cases/ServerTests.hx +++ b/tests/server/src/cases/ServerTests.hx @@ -65,13 +65,13 @@ class ServerTests extends TestCase { assertHasPrint("2"); } - function testDceEmpty() { - vfs.putContent("Empty.hx", getTemplate("Empty.hx")); - var args = ["-main", "Empty", "--no-output", "-java", "java"]; - runHaxe(args); - runHaxeJson(args, cast "typer/compiledTypes" /* TODO */, {}); - assertHasField("", "Type", "enumIndex", true); - } + // function testDceEmpty() { + // vfs.putContent("Empty.hx", getTemplate("Empty.hx")); + // var args = ["-main", "Empty", "--no-output", "--jvm", "java"]; + // runHaxe(args); + // runHaxeJson(args, cast "typer/compiledTypes" /* TODO */, {}); + // assertHasField("", "Type", "enumIndex", true); + // } function testBuildMacro() { vfs.putContent("BuildMacro.hx", getTemplate("BuildMacro.hx")); diff --git a/tests/sys/compile-cs.hxml b/tests/sys/compile-cs.hxml deleted file mode 100644 index 07463c11c78..00000000000 --- a/tests/sys/compile-cs.hxml +++ /dev/null @@ -1,18 +0,0 @@ -compile-each.hxml ---main Main --cs bin/cs - ---next -compile-each.hxml ---main TestArguments --cs bin/cs - ---next -compile-each.hxml ---main ExitCode --cs bin/cs - ---next -compile-each.hxml ---main UtilityProcess --cs bin/cs \ No newline at end of file diff --git a/tests/sys/compile-java.hxml b/tests/sys/compile-java.hxml deleted file mode 100644 index c0039cb9798..00000000000 --- a/tests/sys/compile-java.hxml +++ /dev/null @@ -1,18 +0,0 @@ -compile-each.hxml ---main Main --java bin/java - ---next -compile-each.hxml ---main TestArguments --java bin/java - ---next -compile-each.hxml ---main ExitCode --java bin/java - ---next -compile-each.hxml ---main UtilityProcess --java bin/java \ No newline at end of file diff --git a/tests/sys/compile.hxml b/tests/sys/compile.hxml index 35c14c48c24..98cf3323299 100644 --- a/tests/sys/compile.hxml +++ b/tests/sys/compile.hxml @@ -4,8 +4,7 @@ --next compile-neko.hxml --next compile-python.hxml --next compile-cpp.hxml ---next compile-cs.hxml ---next compile-java.hxml +--next compile-jvm.hxml --next compile-php.hxml --next compile-hl.hxml --next compile-js.hxml diff --git a/tests/sys/gen_test_res.py b/tests/sys/gen_test_res.py index 4905a4c599c..394d0997ebb 100755 --- a/tests/sys/gen_test_res.py +++ b/tests/sys/gen_test_res.py @@ -79,8 +79,6 @@ for target, name in [ ("../../bin/cpp/UtilityProcess-debug", "bin-cpp-debug"), ("../../bin/cpp/UtilityProcess", "bin-cpp"), - ("../../bin/cs/bin/UtilityProcess-Debug.exe", "bin-cs-debug"), - ("../../bin/cs/bin/UtilityProcess.exe", "bin-cs"), ("../../bin/hl/UtilityProcess.hl", "bin-hl"), ("../../bin/hlc/utilityProcess/UtilityProcess.exe", "bin-hlc"), ("../../bin/lua/UtilityProcess.lua", "bin-lua"), diff --git a/tests/sys/run.hxml b/tests/sys/run.hxml index bbd1e0ee21e..0374b25e2ad 100644 --- a/tests/sys/run.hxml +++ b/tests/sys/run.hxml @@ -13,7 +13,6 @@ compile.hxml --cmd echo Neko && export EXISTS=1 && neko bin/neko/sys.n --cmd echo Python && export EXISTS=1 && python3 bin/python/sys.py --cmd echo Cpp && export EXISTS=1 && bin/cpp/Main-debug ---cmd echo CS && export EXISTS=1 && mono bin/cs/bin/Main-Debug.exe --cmd echo Java && export EXISTS=1 && java -jar bin/java/Main-Debug.jar --cmd echo Php && export EXISTS=1 && php bin/php/Main/index.php --cmd echo Hl && export EXISTS=1 && hl bin/hl/sys.hl @@ -26,7 +25,6 @@ compile.hxml # --cmd echo Neko && set EXISTS=1 && neko bin\neko\sys.n # --cmd echo Python && set EXISTS=1 && python3 bin\python\sys.py # --cmd echo Cpp && set EXISTS=1 && bin\cpp\Main-debug.exe -# --cmd echo CS && set EXISTS=1 && bin\cs\bin\Main-Debug.exe # --cmd echo Java && set EXISTS=1 && java -jar bin\java\Main-Debug.jar # --cmd echo Php && set EXISTS=1 && php -c ..\PHP.ini bin\php\Main\index.php # --cmd echo Hl && set EXISTS=1 && hl bin/hl/sys.hl diff --git a/tests/sys/src/ExitCode.hx b/tests/sys/src/ExitCode.hx index 17a2e6cc115..44b4d216b14 100644 --- a/tests/sys/src/ExitCode.hx +++ b/tests/sys/src/ExitCode.hx @@ -23,20 +23,8 @@ class ExitCode { #else "bin/cpp/ExitCode"; #end - #elseif cs - #if debug - "bin/cs/bin/ExitCode-Debug.exe"; - #else - "bin/cs/bin/ExitCode.exe"; - #end #elseif jvm "bin/jvm/ExitCode.jar"; - #elseif java - #if debug - "bin/java/ExitCode-Debug.jar"; - #else - "bin/java/ExitCode.jar"; - #end #elseif python "bin/python/ExitCode.py"; #elseif php diff --git a/tests/sys/src/FileNames.hx b/tests/sys/src/FileNames.hx index 6c3eb2f0e7e..bed98d29fcc 100644 --- a/tests/sys/src/FileNames.hx +++ b/tests/sys/src/FileNames.hx @@ -28,7 +28,7 @@ class FileNames { case _: [ // 255 bytes is the max filename length according to http://en.wikipedia.org/wiki/Comparison_of_file_systems - #if !(python || neko || cpp || java || cs) + #if !(python || neko || cpp || jvm) [for (i in 0...255) "a"].join(""), #end ]; diff --git a/tests/sys/src/TestArguments.hx b/tests/sys/src/TestArguments.hx index 264be8fe1ee..791c83e99cc 100644 --- a/tests/sys/src/TestArguments.hx +++ b/tests/sys/src/TestArguments.hx @@ -83,20 +83,8 @@ class TestArguments extends utest.Test { #else "bin/cpp/TestArguments"; #end - #elseif cs - #if debug - "bin/cs/bin/TestArguments-Debug.exe"; - #else - "bin/cs/bin/TestArguments.exe"; - #end #elseif jvm "bin/jvm/TestArguments.jar"; - #elseif java - #if debug - "bin/java/TestArguments-Debug.jar"; - #else - "bin/java/TestArguments.jar"; - #end #elseif python "bin/python/TestArguments.py"; #elseif php diff --git a/tests/sys/src/TestCommandBase.hx b/tests/sys/src/TestCommandBase.hx index 5d271e14b6c..876f1617e12 100644 --- a/tests/sys/src/TestCommandBase.hx +++ b/tests/sys/src/TestCommandBase.hx @@ -13,23 +13,14 @@ class TestCommandBase extends utest.Test { var bin = FileSystem.absolutePath(TestArguments.bin); var args = TestArguments.expectedArgs; - #if !cs var exitCode = run("haxe", ["compile-each.hxml", "--run", "TestArguments"].concat(args)); Assert.equals(0, exitCode); - #end var exitCode = #if (macro || interp) run("haxe", ["compile-each.hxml", "--run", "TestArguments"].concat(args)); #elseif cpp run(bin, args); - #elseif cs - switch (Sys.systemName()) { - case "Windows": - run(bin, args); - case _: - run("mono", [bin].concat(args)); - } #elseif java run(Path.join([java.lang.System.getProperty("java.home"), "bin", "java"]), ["-jar", bin].concat(args)); #elseif python @@ -120,13 +111,6 @@ class TestCommandBase extends utest.Test { run("haxe", ["compile-each.hxml", "--run", "ExitCode"].concat(args)); #elseif cpp run(bin, args); - #elseif cs - switch (Sys.systemName()) { - case "Windows": - run(bin, args); - case _: - run("mono", [bin].concat(args)); - } #elseif java run(Path.join([java.lang.System.getProperty("java.home"), "bin", "java"]), ["-jar", bin].concat(args)); #elseif python diff --git a/tests/sys/src/TestSys.hx b/tests/sys/src/TestSys.hx index 68196f8ea00..ed62ff17a89 100644 --- a/tests/sys/src/TestSys.hx +++ b/tests/sys/src/TestSys.hx @@ -16,7 +16,7 @@ class TestSys extends TestCommandBase { // new copies should not be affected Assert.isNull(Sys.environment()[nonExistent]); - #if !java + #if !jvm // env should not update when environment updates final toUpdate = "TO_UPDATE"; @@ -31,13 +31,9 @@ class TestSys extends TestCommandBase { Assert.equals("1", Sys.getEnv(toUpdate)); // variables set via target specific api should exist - #if (cs || python) + #if python final toSetNatively = "SET_NATIVELY"; - #if cs - cs.system.Environment.SetEnvironmentVariable(toSetNatively, "1"); - #elseif python python.lib.Os.environ.set(toSetNatively, "1"); - #end Assert.equals("1", Sys.environment()[toSetNatively]); #end #end @@ -62,7 +58,7 @@ class TestSys extends TestCommandBase { Assert.isNull(Sys.getEnv("doesn't exist")); } - #if !java + #if !jvm function testPutEnv() { Sys.putEnv("FOO", "value"); Assert.equals("value", Sys.getEnv("FOO")); @@ -116,12 +112,8 @@ class TestSys extends TestCommandBase { case _: Assert.isTrue(StringTools.endsWith(p, "Main-debug")); } - #elseif cs - Assert.isTrue(StringTools.endsWith(p, "Main-Debug.exe")); #elseif jvm Assert.isTrue(StringTools.endsWith(p, "sys.jar")); - #elseif java - Assert.isTrue(StringTools.endsWith(p, "Main-Debug.jar")); #elseif python Assert.isTrue(StringTools.endsWith(p, "sys.py")); #elseif php @@ -137,7 +129,7 @@ class TestSys extends TestCommandBase { Assert.notEquals(current, haxe.io.Path.removeTrailingSlashes(current)); } - #if !java + #if !jvm function testSetCwd() { var cur = Sys.getCwd(); Sys.setCwd("../"); diff --git a/tests/sys/src/TestUnicode.hx b/tests/sys/src/TestUnicode.hx index b32a63e7c29..fd98c1f2582 100644 --- a/tests/sys/src/TestUnicode.hx +++ b/tests/sys/src/TestUnicode.hx @@ -16,12 +16,6 @@ class TestUnicode extends utest.Test { #else "bin-cpp"; #end -#elseif cs - #if debug - "bin-cs-debug"; - #else - "bin-cs"; - #end #elseif hl #if hlc "bin-hlc"; @@ -32,12 +26,6 @@ class TestUnicode extends utest.Test { "bin-lua"; #elseif jvm "bin-jvm"; -#elseif java - #if debug - "bin-java-debug"; - #else - "bin-java"; - #end #elseif neko "bin-neko"; #elseif php @@ -152,8 +140,7 @@ class TestUnicode extends utest.Test { #if target.unicode function testFilesystem() { -#if !java // java does not have this functionality -#if !cs // C# disabled temporarily (#8247) +#if !jvm // java does not have this functionality // setCwd + getCwd Sys.setCwd("test-res"); function enterLeave(dir:String, ?alt:String):Void { @@ -168,7 +155,6 @@ class TestUnicode extends utest.Test { if (FileSystem.exists(nfd)) enterLeave(nfd, nfc); } Sys.setCwd(".."); -#end #end // absolutePath @@ -189,8 +175,7 @@ class TestUnicode extends utest.Test { ); }, "test-res"); -#if !java // java does not have this functionality -#if !cs // C# disabled temporarily (#8247) +#if !jvm // java does not have this functionality assertNormalEither(path -> { if (!FileSystem.exists(path)) return false; // NFC/NFD differences Sys.setCwd(path); @@ -209,7 +194,6 @@ class TestUnicode extends utest.Test { Sys.setCwd("../.."); return ret; }, "test-res", "setCwd + absolutePath + endsWith failed"); -#end #end // exists @@ -218,7 +202,6 @@ class TestUnicode extends utest.Test { // fullPath #if !lua // Lua disabled temporarily (#8215) - #if !cs // C# behaves like Windows here if (Sys.systemName() != "Windows") { // symlinks behave strangely on Windows pathBoth(path -> { @@ -228,7 +211,6 @@ class TestUnicode extends utest.Test { ); }, "test-res"); } - #end #end // isDirectory @@ -236,11 +218,9 @@ class TestUnicode extends utest.Test { assertNormalEither(path -> !FileSystem.isDirectory(path), 'test-res/b', 'expected isDirectory == false'); // readDirectory -#if !cs // C# disabled temporarily (#8247) sameFiles(FileSystem.readDirectory("test-res"), namesRoot); sameFiles(FileSystem.readDirectory("test-res/a"), names); sameFiles(FileSystem.readDirectory("test-res/b"), names); -#end // stat assertNormalEither(path -> FileSystem.stat(path) != null, 'test-res/a', 'expected stat != null'); @@ -322,7 +302,7 @@ class TestUnicode extends utest.Test { assertUEquals(runUtility(["println", '$i', mode]).stdout, str + endLine); // trace assertUEnds(runUtility(["trace", '$i', mode]).stdout, str + endLine); - #if !java + #if !jvm // putEnv + getEnv assertUEquals(runUtility(["putEnv", "HAXE_TEST", '$i', mode, "getEnv", "HAXE_TEST"]).stdout, str + endLine); // putEnv + environment @@ -331,14 +311,12 @@ class TestUnicode extends utest.Test { }); // args - #if !cs // C# behaves like Windows here - if (#if (java || eval || cpp) Sys.systemName() != "Windows" #else true #end) { + if (#if (jvm || eval || cpp) Sys.systemName() != "Windows" #else true #end) { // https://stackoverflow.com/questions/7660651/passing-command-line-unicode-argument-to-java-code UnicodeSequences.normalBoth(str -> { assertUEquals(runUtility(["args", str]).stdout, str + endLine); }); } - #end } #end @@ -358,26 +336,22 @@ class TestUnicode extends utest.Test { // saveContent File.saveContent("temp-unicode/data.bin", UnicodeSequences.validString); assertBytesEqual(File.getBytes("temp-unicode/data.bin"), UnicodeSequences.validBytes); -#if !cs // C# disabled temporarily (#8247) pathBoth(str -> { File.saveContent('temp-unicode/saveContent-$str.bin', UnicodeSequences.validString); assertBytesEqual(File.getBytes('temp-unicode/saveContent-$str.bin'), UnicodeSequences.validBytes); }); -#end // write var out = File.write("temp-unicode/out.bin"); out.writeString(UnicodeSequences.validString); out.close(); assertBytesEqual(File.getBytes("temp-unicode/out.bin"), UnicodeSequences.validBytes); -#if !cs // C# disabled temporarily (#8247) pathBoth(str -> { var out = File.write('temp-unicode/write-$str.bin'); out.writeString(UnicodeSequences.validString); out.close(); assertBytesEqual(File.getBytes('temp-unicode/write-$str.bin'), UnicodeSequences.validBytes); }); -#end // update var out = File.update("temp-unicode/out.bin"); diff --git a/tests/sys/src/UtilityProcess.hx b/tests/sys/src/UtilityProcess.hx index e17be3d092f..0e88a19b4f5 100644 --- a/tests/sys/src/UtilityProcess.hx +++ b/tests/sys/src/UtilityProcess.hx @@ -10,8 +10,6 @@ class UtilityProcess { public static var BIN_PATH = #if cpp Path.join(["bin", "cpp"]); -#elseif cs - Path.join(["bin", "cs", "bin"]); #elseif hl #if hlc Path.join(["bin", "hlc/utilityProcess"]); @@ -22,8 +20,6 @@ class UtilityProcess { Path.join(["bin", "lua"]); #elseif jvm Path.join(["bin", "jvm"]); -#elseif java - Path.join(["bin", "java"]); #elseif neko Path.join(["bin", "neko"]); #elseif php @@ -44,12 +40,6 @@ class UtilityProcess { #else "UtilityProcess"; #end -#elseif cs - #if debug - "UtilityProcess-Debug.exe"; - #else - "UtilityProcess.exe"; - #end #elseif hl #if hlc "UtilityProcess.exe"; @@ -60,12 +50,6 @@ class UtilityProcess { "UtilityProcess.lua"; #elseif jvm "UtilityProcess.jar"; -#elseif java - #if debug - "UtilityProcess-Debug.jar"; - #else - "UtilityProcess.jar"; - #end #elseif neko "UtilityProcess.n"; #elseif php @@ -94,13 +78,6 @@ class UtilityProcess { new Process("haxe", ["compile-each.hxml", "-p", options.execPath, "--run", options.execName].concat(args)); #elseif cpp new Process(execFull, args); - #elseif cs - (switch (Sys.systemName()) { - case "Windows": - new Process(execFull, args); - case _: - new Process("mono", [execFull].concat(args)); - }); #elseif java new Process(Path.join([java.lang.System.getProperty("java.home"), "bin", "java"]), ["-jar", execFull].concat(args)); #elseif python @@ -150,13 +127,6 @@ class UtilityProcess { Sys.command("haxe", ["compile-each.hxml", "-p", options.execPath, "--run", options.execName].concat(args)); #elseif cpp Sys.command(execFull, args); - #elseif cs - (switch (Sys.systemName()) { - case "Windows": - Sys.command(execFull, args); - case _: - Sys.command("mono", [execFull].concat(args)); - }); #elseif java Sys.command(Path.join([java.lang.System.getProperty("java.home"), "bin", "java"]), ["-jar", execFull].concat(args)); #elseif python diff --git a/tests/unit/compile-cs-unsafe.hxml b/tests/unit/compile-cs-unsafe.hxml deleted file mode 100644 index 22c378fb1af..00000000000 --- a/tests/unit/compile-cs-unsafe.hxml +++ /dev/null @@ -1,10 +0,0 @@ -#cs native build --cmd "haxelib run hxcs native_cs/hxcs_build.txt" - ---next - -compile-each.hxml ---main unit.TestMain --D unsafe --cs bin/cs_unsafe ---net-lib native_cs/bin/native_cs.dll diff --git a/tests/unit/compile-cs.hxml b/tests/unit/compile-cs.hxml deleted file mode 100644 index 041caa389d0..00000000000 --- a/tests/unit/compile-cs.hxml +++ /dev/null @@ -1,9 +0,0 @@ -#cs native build --cmd "haxelib run hxcs native_cs/hxcs_build.txt" - ---next - -compile-each.hxml ---main unit.TestMain --cs bin/cs ---net-lib native_cs/bin/native_cs.dll diff --git a/tests/unit/compile-exe-runner.hxml b/tests/unit/compile-exe-runner.hxml deleted file mode 100644 index e5407faec72..00000000000 --- a/tests/unit/compile-exe-runner.hxml +++ /dev/null @@ -1,3 +0,0 @@ --p src ---main RunExe --neko bin/runexe.n \ No newline at end of file diff --git a/tests/unit/compile-java-runner.hxml b/tests/unit/compile-java-runner.hxml deleted file mode 100644 index 737054da258..00000000000 --- a/tests/unit/compile-java-runner.hxml +++ /dev/null @@ -1,3 +0,0 @@ --p src ---main RunJava --neko bin/runjava.n \ No newline at end of file diff --git a/tests/unit/compile-java.hxml b/tests/unit/compile-java.hxml deleted file mode 100644 index 33e92d21898..00000000000 --- a/tests/unit/compile-java.hxml +++ /dev/null @@ -1,10 +0,0 @@ -compile-java-native.hxml - ---next - -compile-each.hxml ---main unit.TestMain --java bin/java ---java-lib native_java/native.jar ---java-lib java_drivers/mysql-connector-java-5.1.32-bin.jar ---java-lib java_drivers/sqlite-jdbc-3.7.2.jar diff --git a/tests/unit/compile.hxml b/tests/unit/compile.hxml index 333e94fec17..6f5f7c507c4 100644 --- a/tests/unit/compile.hxml +++ b/tests/unit/compile.hxml @@ -1,14 +1,3 @@ -# unittest helpers - -# exe-runner ---next -compile-exe-runner.hxml - -# java-runner ---next -compile-java-runner.hxml - - # targets --next compile-flash.hxml @@ -19,8 +8,6 @@ compile-java-runner.hxml --next compile-neko.hxml --next compile-php.hxml --next compile-cpp.hxml ---next compile-java.hxml ---next compile-cs.hxml +--next compile-jvm.hxml --next compile-python.hxml ---next compile-cs-unsafe.hxml --next compile-macro.hxml diff --git a/tests/unit/native_cs/hxcs_build.txt b/tests/unit/native_cs/hxcs_build.txt deleted file mode 100644 index fdfcf6d7b2d..00000000000 --- a/tests/unit/native_cs/hxcs_build.txt +++ /dev/null @@ -1,28 +0,0 @@ -./ -begin modules -M haxe.test.OverloadInterface1 -C haxe.test.OverloadInterface1 -M haxe.test.OverloadInterface2 -C haxe.test.OverloadInterface2 -M haxe.test.MyClass -C haxe.test.MyClass -M haxe.test.TEnum -E haxe.test.TEnum -M haxe.test.TEnumWithValue -E haxe.test.TEnumWithValue -M haxe.test.Base -C haxe.test.Base -M haxe.test.Generic1 -C haxe.test.Generic1 -M haxe.test.GenericHelper -C haxe.test.GenericHelper -M haxe.test.StaticAndInstanceClash -C haxe.test.StaticAndInstanceClash -M haxe.test.AttrWithNullType -C haxe.test.AttrWithNullType -M NoPackage -C NoPackage -end modules -begin defines -dll -end defines diff --git a/tests/unit/native_cs/src/NoPackage.cs b/tests/unit/native_cs/src/NoPackage.cs deleted file mode 100644 index 59c87296e22..00000000000 --- a/tests/unit/native_cs/src/NoPackage.cs +++ /dev/null @@ -1,21 +0,0 @@ -public class NoPackage -{ - public NoPackInner b; - public bool isWorking; - - public NoPackage() - { - isWorking = true; - b = new NoPackInner(); - } - - public class NoPackInner - { - public bool isReallyWorking; - - public NoPackInner() - { - isReallyWorking = true; - } - } -} diff --git a/tests/unit/native_cs/src/haxe/test/AttrWithNullType.cs b/tests/unit/native_cs/src/haxe/test/AttrWithNullType.cs deleted file mode 100644 index 703cd589915..00000000000 --- a/tests/unit/native_cs/src/haxe/test/AttrWithNullType.cs +++ /dev/null @@ -1,17 +0,0 @@ -using System; - -namespace haxe.test { - [MyAttr(null)] - public class AttrWithNullType {} - - [MyAttr(typeof(AttrWithNullType))] - public class AttrWithNonNullType {} - - public class MyAttrAttribute : Attribute { - public bool check; - - public MyAttrAttribute(System.Type t) { - check = (t == null); - } - } -} diff --git a/tests/unit/native_cs/src/haxe/test/Base.cs b/tests/unit/native_cs/src/haxe/test/Base.cs deleted file mode 100644 index 822665b0979..00000000000 --- a/tests/unit/native_cs/src/haxe/test/Base.cs +++ /dev/null @@ -1,167 +0,0 @@ -namespace haxe.test -{ - -public class Base -{ - ~Base() { someString = null; } - //some haxe-specific keywords - - public static readonly int inline = 42; - public static readonly int callback = 43; - public static readonly int cast = 44; - public static int untyped = 45; - - //final + static variable = inline var in Haxe - const int inlineNumber = 42; - - //cannot be inline - public static int notInlineNumber = 42; - - public string someString; - private string privateField; - protected int protectedField; - - //static + nonstatic clash - public static int nameClash(Base t) - { - return -1; - } - - public string prop - { - get - { - return "SomeValue"; - } - } - - public int this[int i] - { - get { return i * 20; } - } - - public int Issue4325 { get; protected set; } - - public void setIssue4325(int val) - { - this.Issue4325 = val; - } - - public int this[int i, int j] - { - get { return i * j; } - } - - public int optional(int i=42) - { - return i * 10; - } - - public virtual int nameClash() - { - return 1; - } - - protected int protectedFunction() - { - return protectedField; - } - - public int varNameClash(int b) - { - return b; - } - - public static double varNameClash(double d) - { - return d; - } - - public static char charTest(char c) - { - return c; - } - - public static byte byteTest(byte b) - { - return b; - } - - public class InnerClass : Base - { - ~InnerClass() { privateField = 0; } - - private int privateField = 42; - - //protected override without explicit override tag - protected int protectedFunction() - { - return privateField; - } - - public override int nameClash() - { - return 10; - } - - public static int getValue(OverloadInterface2 oiface) - { - return oiface.someOverloadedMethod(42); - } - - public class InnerInnerClass : InnerClass2 - { - - - //protected override without explicit override tag - protected int protectedFunction() - { - return 10; - } - } - } - - public class InnerClass2 : InnerClass, OverloadInterface1, OverloadInterface2 - { - public void someOverloadedMethod(string a1) - { - - } - - public int someOverloadedMethod(int a1) - { - return a1; - } - } -} - -// Issue #3474 - -public interface ITextFile -{ - string Property { get; } -} - -public interface ITextBuffer : ITextFile -{ -} - -public interface IEditableTextFile : ITextFile -{ - new string Property { get; set; } -} - -public interface IEditableTextBuffer : IEditableTextFile, ITextBuffer -{ -} - -public class lowerCaseClass -{ - public bool works; - public lowerCaseClass() - { - works = true; - } -} - -} diff --git a/tests/unit/native_cs/src/haxe/test/Generic1.cs b/tests/unit/native_cs/src/haxe/test/Generic1.cs deleted file mode 100644 index a8c2f734880..00000000000 --- a/tests/unit/native_cs/src/haxe/test/Generic1.cs +++ /dev/null @@ -1,39 +0,0 @@ -namespace haxe.test -{ - -public class Generic1 where T : Base -{ - public T value; - - public Generic1() - { - - } - - public Generic1(T value) - { - this.value = value; - } - - public void setValue(T v) - { - this.value = v; - } - - public T getValue() - { - return value; - } - - public string getSomeString() - { - return value.someString; - } - - public string complexTypeParameterOfTypeParameter(B2 b) where B2 : T - { - return b.someString + value.someString; - } -} - -} diff --git a/tests/unit/native_cs/src/haxe/test/GenericHelper.cs b/tests/unit/native_cs/src/haxe/test/GenericHelper.cs deleted file mode 100644 index bee71909975..00000000000 --- a/tests/unit/native_cs/src/haxe/test/GenericHelper.cs +++ /dev/null @@ -1,14 +0,0 @@ -namespace haxe.test -{ - -public class GenericHelper -{ - public Generic1 typedGeneric; - - public static Generic1 staticTypedGeneric(X cl) where X : Base.InnerClass - { - return new Generic1(); - } -} - -} diff --git a/tests/unit/native_cs/src/haxe/test/MyClass.cs b/tests/unit/native_cs/src/haxe/test/MyClass.cs deleted file mode 100644 index acbde2b3e63..00000000000 --- a/tests/unit/native_cs/src/haxe/test/MyClass.cs +++ /dev/null @@ -1,90 +0,0 @@ -namespace haxe.test -{ - -public class MyClass -{ - virtual public void normalOverload(string a) - { - - } - - virtual public void normalOverload(int a) - { - - } - - virtual public void normalOverload(bool a) - { - - } - - virtual public void normalOverload(object a) - { - - } - - virtual public void normalOverload(long a) - { - - } - - virtual public void normalOverload(float a) - { - - } - - virtual public void normalOverload(double a) - { - - } - - virtual public void normalOverload(Base a) - { - - } - - virtual public void normalOverload(VoidVoid a) - { - } - - public void outTest(out int i) - { - i = 42; - } - - public void refTest(ref int i) - { - i *= 42; - } - - public void dispatch() - { - if (voidvoid != null) - this.voidvoid.Invoke(); - } - - virtual public int SomeProp - { - get { return 42; } - } - - virtual public int SomeProp2 - { - get { return 42; } - } - - public event VoidVoid voidvoid; - public static event VoidVoid voidvoid2; - - public static void dispatch2() - { - if (voidvoid2 != null) - voidvoid2.Invoke(); - } - - public readonly int readonlyField = 5; -} - -public delegate void VoidVoid(); - -} diff --git a/tests/unit/native_cs/src/haxe/test/OverloadInterface1.cs b/tests/unit/native_cs/src/haxe/test/OverloadInterface1.cs deleted file mode 100644 index 2b54893468d..00000000000 --- a/tests/unit/native_cs/src/haxe/test/OverloadInterface1.cs +++ /dev/null @@ -1,9 +0,0 @@ -namespace haxe.test -{ - -public interface OverloadInterface1 -{ - void someOverloadedMethod(string a1); -} - -} diff --git a/tests/unit/native_cs/src/haxe/test/OverloadInterface2.cs b/tests/unit/native_cs/src/haxe/test/OverloadInterface2.cs deleted file mode 100644 index 1e2c6aefaa3..00000000000 --- a/tests/unit/native_cs/src/haxe/test/OverloadInterface2.cs +++ /dev/null @@ -1,9 +0,0 @@ -namespace haxe.test -{ - -public interface OverloadInterface2 -{ - int someOverloadedMethod(int a1); -} - -} diff --git a/tests/unit/native_cs/src/haxe/test/StaticAndInstanceClash.cs b/tests/unit/native_cs/src/haxe/test/StaticAndInstanceClash.cs deleted file mode 100644 index f9a0ccbe45e..00000000000 --- a/tests/unit/native_cs/src/haxe/test/StaticAndInstanceClash.cs +++ /dev/null @@ -1,36 +0,0 @@ -namespace haxe.test -{ - -public class StaticAndInstanceClash : Base.InnerClass -{ - ~StaticAndInstanceClash() {} - public static string someString; - - public class StaticAndInstanceClashSame : StaticAndInstanceClash - { - public int someInt; - } - - public class StaticAndInstanceAndMethodClash : StaticAndInstanceClashSame - { - - private float sfloat = 5; - private int sint = 5; - public float someFloat() - { - return sfloat; - } - - public float someFloat(float val) - { - return sfloat = val; - } - - public int someInt() - { - return sint; - } - } -} - -} diff --git a/tests/unit/native_cs/src/haxe/test/TEnum.cs b/tests/unit/native_cs/src/haxe/test/TEnum.cs deleted file mode 100644 index 0120ef436e8..00000000000 --- a/tests/unit/native_cs/src/haxe/test/TEnum.cs +++ /dev/null @@ -1,9 +0,0 @@ -namespace haxe.test -{ - -public enum TEnum -{ - TA,TB,TC -} - -} diff --git a/tests/unit/native_cs/src/haxe/test/TEnumWithValue.cs b/tests/unit/native_cs/src/haxe/test/TEnumWithValue.cs deleted file mode 100644 index 28c3946d497..00000000000 --- a/tests/unit/native_cs/src/haxe/test/TEnumWithValue.cs +++ /dev/null @@ -1,33 +0,0 @@ -namespace haxe.test -{ - -public enum TEnumWithValue -{ - TVA = 0x100,TVB = 0x1,TVD = 0x10, TVC = 0x20 -} - -public enum TEnumWithBigValue : ulong -{ - TBA = 0x1000000000L, - TBD = 0x200000000000L, - TBB = 0x100000000L, - TBC = 0x3000000000000L, -} - -[System.Flags] -public enum TEnumWithFlag -{ - TFA = 0x100,TFB = 0x1,TFD = 0x10, TFC = 0x20 -} - -[System.Flags] -public enum TEnumWithBigFlag : ulong -{ - TFBA = 0x1000000000L, - TFBD = 0x200000000000L, - TFBB = 0x100000000L, - TFBC = 0x3000000000000L, -} - -} - diff --git a/tests/unit/src/RunCastGenerator.hx b/tests/unit/src/RunCastGenerator.hx index fc08fac35f2..1b74d634bd5 100644 --- a/tests/unit/src/RunCastGenerator.hx +++ b/tests/unit/src/RunCastGenerator.hx @@ -83,7 +83,7 @@ class RunCastGenerator { } line("// This file is auto-generated from RunCastGenerator.hx - do not edit!"); line("package unit;"); - line("#if java"); + line("#if jvm"); line("import java.StdTypes;"); line("private typedef Int32 = Int;"); line("private typedef Float32 = Single;"); diff --git a/tests/unit/src/unit/MyClass.hx b/tests/unit/src/unit/MyClass.hx index 514d123edb2..d23c9b5afe1 100644 --- a/tests/unit/src/unit/MyClass.hx +++ b/tests/unit/src/unit/MyClass.hx @@ -153,10 +153,8 @@ class ParamConstraintsClass { public function memberAnon < A:{ x : Int } & { y : Float }> (v:A) { return v.x + v.y; } -#if !(java || cs) //this is a known bug caused by issue #915 @:overload(function< A, B:Array > (a:A, b:B):Void { } ) public function memberOverload < A, B > (a:String, b:String) { } -#end } class ParamConstraintsClass2 { @@ -295,4 +293,4 @@ class InlineCastB extends InlineCastA { public function quote() { return "I am the greatest."; } -} \ No newline at end of file +} diff --git a/tests/unit/src/unit/TestCSharp.hx b/tests/unit/src/unit/TestCSharp.hx deleted file mode 100644 index 42991f12736..00000000000 --- a/tests/unit/src/unit/TestCSharp.hx +++ /dev/null @@ -1,840 +0,0 @@ -package unit; -import haxe.io.Bytes; -import haxe.test.Base; -import haxe.test.Base.Base_InnerClass; -import haxe.test.TEnum; -import haxe.test.TEnumWithValue; -import haxe.test.TEnumWithBigValue; -import haxe.test.TEnumWithFlag; -import haxe.test.TEnumWithBigFlag; -import haxe.test.IEditableTextBuffer; -import haxe.test.LowerCaseClass; - -import cs.Flags; -import cs.system.componentmodel.DescriptionAttribute; - -import NoPackage; -#if unsafe -import cs.Pointer; -#end -import cs.system.Action_1; - -//C#-specific tests, like unsafe code -class TestCSharp extends Test -{ -#if cs - - function testIssue4325() - { - var b = new Base(); - eq(b.Issue4325, 0); - b.setIssue4325(10); - eq(b.Issue4325, 10); - } - - // -net-lib tests - function testHaxeKeywords() - { - eq(Base._inline, 42); - eq(Base.callback, 43); - eq(Base._cast, 44); - eq(Base._untyped, 45); - Base._untyped = 40; - eq(Base._untyped, 40); - } - - function testIssue3474() - { - var a:IEditableTextBuffer = cast null; - eq(a,null); - var didRun = false; - try - { - eq(a.Property, "should not succeed"); - } - catch(e:Dynamic) - { - didRun = true; - } - - t(didRun); - } - - function testLowerCase() - { - var l = new LowerCaseClass(); - t(l.works); - } - - function testGetItem() - { - var b = new Base(); - eq(b[1], 20); - eq(b.get_Item(2,3), 6); - var dyn:Dynamic = b; - eq(dyn[1], 20); - eq(dyn.get_Item(2,3), 6); - - var b:Base = new Base_InnerClass(); - eq(b[1], 20); - eq(b.get_Item(2,3), 6); - var dyn:Dynamic = b; - eq(dyn[1], 20); - eq(dyn.get_Item(2,3), 6); - } - - // function testOptional() - // { - // eq(new Base().optional(), 420); - // eq(new Base().optional(10), 100); - // } - - function testProp() - { - var b = new Base(); - eq(b.prop, "SomeValue"); - var dyn:Dynamic = b; - eq(dyn.prop, "SomeValue"); - } - -#if unsafe - @:unsafe function testBoxedPointer() - { - var ptr:Pointer = cast cs.system.runtime.interopservices.Marshal.AllocHGlobal(10 * 4).ToPointer(); - ptr[0] = 0; - eq(ptr[0],0); - ptr[0] = -1; - eq(ptr[0],-1); - - var dyn:Dynamic = ptr; - ptr = null; - ptr = dyn; - eq(ptr[0],-1); - - var arr = [ptr]; - eq(arr[0][0], -1); - - var captured = ptr; - function test(v:Int) captured[0] = v; - - test(0xFFFF); - eq(ptr[0],0xFFFF); - eq(captured[0],0xFFFF); - t(ptr == captured); - - var other:Pointer> = cast cs.system.runtime.interopservices.Marshal.AllocHGlobal(10 * 4).ToPointer(); - other[0] = ptr; - eq(other[0][0], 0xFFFF); - var captured = other; - function test(v:Int) captured[0][0] = v; - test(-1); - eq(other[0][0],-1); - eq(captured[0][0],-1); - t(other == captured); - - function test2(p:Pointer>, v:Int) - p[0][0]=v; - - test2(other,-2); - eq(other[0][0],-2); - } - - @:unsafe function testPointerAccess() - { - var struct = new SomeStruct(10,20); - eq(10,struct.int); - eq(20.0,struct.float); - - var addr = cs.Lib.addressOf(struct); - eq(10,addr.acc.int); - eq(20.0,addr.acc.float); - addr.acc.int = 22; - eq(22,addr.acc.int); - eq(22,struct.int); - - addr.acc.float = 42.42; - eq(42.42,addr.acc.float); - eq(42.42,struct.float); - - var arr = new cs.NativeArray(10); - cs.Lib.fixed({ - var arrptr = cs.Lib.pointerOfArray(arr); - for (i in 0...10) - { - (arrptr + i).acc.int = i; - (arrptr + i).acc.float = i + i / 10; - } - var ptr = arrptr; - for (i in 0...10) - { - eq(arr[i].int,i); - eq(arr[i].float,i + i / 10); - - eq((arrptr + i).acc.int, i); - eq((arrptr + i).acc.float, i + i / 10); - - ptr.acc.int = i *2; - ptr.acc.float = (i + i / 10) * 2; - ptr++; - } - for (i in 0...10) - { - eq(arr[i].int,i*2); - eq(arr[i].float,(i + i / 10)*2); - - eq((arrptr + i).acc.int, i*2); - eq((arrptr + i).acc.float, (i + i / 10)*2); - } - }); - } -#end - - function testTypes() - { - eq(Base.charTest(cast 10), cast 10); - eq(Base.byteTest(cast 10), cast 10); - } - - function testInnerClass() - { - //-java-lib should be able to detect inner classes on import - var i = new Base_InnerClass(); - eq(10,i.nameClash()); - - var i2 = new Base_InnerClass_InnerInnerClass(); - t(true); - - var noPack:NoPackage = new NoPackage(); - t(noPack.isWorking); - t(noPack.b != null); - t(noPack.b.isReallyWorking); - - var noPack2 = new NoPackage.NoPackage_NoPackInner(); - t(noPack2.isReallyWorking); - } - - function testGenerics() - { - // t(haxe.test.GenericHelper.staticTypedGeneric(new Base_InnerClass_InnerInnerClass()) != null); - - var helper = new haxe.test.GenericHelper(); - - var val = new Base_InnerClass(); - var g1 = new haxe.test.Generic1_1(val); - g1.complexTypeParameterOfTypeParameter(new Base_InnerClass_InnerInnerClass()); - //if no compile-time error, we're fine! - t(true); - } - - function testDelegates() - { - var run = false; - var v:haxe.test.VoidVoid = function () run = true; - f(run); - v.Invoke(); - t(run); - f(didRun); - v = doRun; - v.Invoke(); - t(didRun); - - run = false; - var someFunc = function() run = true; - f(run); - v = someFunc; - f(run); - v.Invoke(); - t(run); - - var someFunc2 = someFunc; - var getFun = function() return someFunc2; - run = false; - f(run); - v = { var x = "complex body"; getFun(); }; - f(run); - v.Invoke(); - t(run); - - //var dyn:Dynamic = v; - //t((dyn is haxe.test.VoidVoid)); - } - - var didRun = false; - function doRun() - { - didRun = true; - } - - function testOverloadOverride() - { - var c = new haxe.test.MyClass(); - eq(42,c.SomeProp); - eq(42,c.SomeProp2); - - var c = new TestMyClass(); - c.normalOverload(true); - t(c.boolCalled); - c.normalOverload(10); - t(c.intCalled); - c.normalOverload(haxe.Int64.ofInt(0)); - t(c.int64Called); - c.normalOverload(""); - t(c.stringCalled); - c.normalOverload({}); - t(c.dynamicCalled); - eq(21,c.SomeProp); - t(c.getCalled); - eq(21,c.SomeProp2); - - var c = new TestMyClass(""); - t(c.alternativeCtorCalled); - var b:haxe.test.MyClass = c; - b.normalOverload(true); - t(c.boolCalled); - b.normalOverload(10); - t(c.intCalled); - b.normalOverload(haxe.Int64.ofInt(0)); - t(c.int64Called); - b.normalOverload(""); - t(c.stringCalled); - b.normalOverload({}); - t(c.dynamicCalled); - eq(21,c.SomeProp); - t(c.getCalled); - eq(21,c.SomeProp2); - } - - function testEnumFlags() - { - var flags = new Flags(TFA) | TFC; - t(flags.has(TFA)); - t(flags.has(TFC)); - f(flags.has(TFB)); - f(flags.has(TFD)); - flags = new Flags(); - f(flags.has(TFA)); - f(flags.has(TFB)); - f(flags.has(TFC)); - f(flags.has(TFD)); - - flags |= TFB; - t(flags.has(TFB)); - eq(flags & TFB,flags); - flags |= TFA; - - f(flags.has(TFD)); - t(flags.hasAny(new Flags(TFD) | TFB)); - f(flags.hasAny(new Flags(TFD) | TFC)); - f(flags.hasAll(new Flags(TFD) | TFB)); - t(flags.hasAll(new Flags(TFB))); - t(flags.hasAll(new Flags(TFA) | TFB)); - - var flags = new Flags(TFBA) | TFBC; - t(flags.has(TFBA)); - t(flags.has(TFBC)); - f(flags.has(TFBB)); - f(flags.has(TFBD)); - flags = new Flags(); - f(flags.has(TFBA)); - f(flags.has(TFBB)); - f(flags.has(TFBC)); - f(flags.has(TFBD)); - - flags |= TFBB; - t(flags.has(TFBB)); - eq(flags & TFBB,flags); - flags |= TFBA; - - f(flags.has(TFBD)); - t(flags.hasAny(new Flags(TFBD) | TFBB)); - f(flags.hasAny(new Flags(TFBD) | TFBC)); - f(flags.hasAll(new Flags(TFBD) | TFBB)); - t(flags.hasAll(new Flags(TFBB))); - t(flags.hasAll(new Flags(TFBA) | TFBB)); - } - - function testEnum() - { - var e = TEnum.TA; - switch(e) - { - case TA: - t(true); - case _: - t(false); - } - eq("TA",Type.enumConstructor(e)); - - eq(Type.enumIndex(getTA()), Type.enumIndex(TEnum.TA)); - eq(Type.enumIndex(getTVA()), Type.enumIndex(TEnumWithValue.TVA)); - eq(Type.enumIndex(getTBA()), Type.enumIndex(TEnumWithBigValue.TBA)); - - eq(Type.enumIndex(getTVB()), Type.enumIndex(TEnumWithValue.TVB)); - eq(Type.enumIndex(getTBB()), Type.enumIndex(TEnumWithBigValue.TBB)); - eq(Type.enumIndex(getTB()), Type.enumIndex(TEnum.TB)); - - eq(Type.enumIndex(getTC()), Type.enumIndex(TEnum.TC)); - eq(Type.enumIndex(getTVC()), Type.enumIndex(TEnumWithValue.TVC)); - eq(Type.enumIndex(getTBC()), Type.enumIndex(TEnumWithBigValue.TBC)); - - eq(Type.enumIndex(getTVD()), Type.enumIndex(TEnumWithValue.TVD)); - eq(Type.enumIndex(getTBD()), Type.enumIndex(TEnumWithBigValue.TBD)); - - checkEnum(TEnum,TEnum.TA); - checkEnum(TEnum,TEnum.TB); - checkEnum(TEnum,TEnum.TC); - - checkEnum(TEnumWithValue,TEnumWithValue.TVA); - checkEnum(TEnumWithValue,TEnumWithValue.TVB); - checkEnum(TEnumWithValue,TEnumWithValue.TVC); - checkEnum(TEnumWithValue,TEnumWithValue.TVD); - - checkEnum(TEnumWithBigValue,TEnumWithBigValue.TBA); - checkEnum(TEnumWithBigValue,TEnumWithBigValue.TBB); - checkEnum(TEnumWithBigValue,TEnumWithBigValue.TBC); - checkEnum(TEnumWithBigValue,TEnumWithBigValue.TBD); - - //issue #2308 - var fn = getEnumValue; - eq(0x100, Reflect.callMethod(null, fn, [TEnumWithValue.TVA])); - - var e = getTVA(); - switch(e) { - case TVA if (getEnumValue(e) == getEnumValue(getTVA())): - t(true); - case _: - t(false); - } - - var e = getTVB(); - switch(e) { - case TVA: - t(false); - case TVB if (getEnumValue(e) != getEnumValue(getTVA())): - t(true); - case _: - t(false); - } - } - - static function getEnumValue(e:TEnumWithValue):Int - { - return cast e; - } - - private static function getArray(arr:cs.system.Array) - { - return [ for (i in 0...arr.Length) arr.GetValue(i) ]; - } - - function checkEnum(e:Enum,v:T,?pos:haxe.PosInfos) - { - var idx = Type.enumIndex(v); - eq(v,Type.createEnumIndex(e,idx),pos); - } - - function getTA() return TEnum.TA; - function getTVA() return TEnumWithValue.TVA; - function getTBA() return TEnumWithBigValue.TBA; - function getTB() return TEnum.TB; - function getTVB() return TEnumWithValue.TVB; - function getTBB() return TEnumWithBigValue.TBB; - function getTC() return TEnum.TC; - function getTVC() return TEnumWithValue.TVC; - function getTBC() return TEnumWithBigValue.TBC; - function getTVD() return TEnumWithValue.TVD; - function getTBD() return TEnumWithBigValue.TBD; - - @:skipReflection private function refTest(i:cs.Ref):Void - { - i *= 2; - } - - @:skipReflection private function refTestAssign(i:cs.Ref):Void - { - i = 2; - } - - @:skipReflection private function outTest(out:cs.Out, x:Int):Void - { - out = x * 2; - } - - // test for https://github.com/HaxeFoundation/haxe/issues/2528 - public function testDynObjectSetField() - { - var a:Dynamic = {}; - a.status = 10; - var b:{status:Int} = a; - b.status = 15; - - eq(a, b); - eq(Reflect.fields(a).length, 1); - eq(Reflect.fields(b).length, 1); - eq(a.status, 15); - eq(b.status, 15); - } - - public function testRef() - { - var i = 10; - refTestAssign(i); - eq(i, 2); - - var i = 10; - refTest(i); - eq(i, 20); - - var cl:NativeClass = new HxClass(); - cl.refTest(i); - eq(i, 80); - - cl.test = 100; - cl.refTest(cl.test); - eq(cl.test,400); - - i = 10; - var cl = new haxe.test.MyClass(); - cl.refTest(i); - eq(i,420); - } - - public function testOut() - { - var i = 0; - outTest(i, 10); - eq(i, 20); - - var cl:NativeClass = new HxClass(); - cl.outTest(i, 10); - eq(i, 40); - - cl.test = 20; - cl.outTest(cl.test, 10); - eq(cl.test,40); - - var cl = new haxe.test.MyClass(); - cl.outTest(i); - eq(i,42); - } - - public function testChecked() - { - exc(function() - { - cs.Lib.checked({ - var x = 1000; - while(true) - { - x *= x; - } - }); - }); - } - - public function testUncheckedAttribute() - { - var cls = cs.Lib.toNativeType( TestMyClass ), - attribType = cs.Lib.toNativeType( cs.system.componentmodel.DescriptionAttribute ); - var attrib:cs.system.componentmodel.DescriptionAttribute = cast cs.system.Attribute.GetCustomAttribute(cls,attribType,true); - t(attrib != null); - eq("MyClass Description", attrib.Description); - - attrib = cast cs.system.Attribute.GetCustomAttribute(cls.GetMethod("argumentDescription"), attribType,true); - t(attrib != null); - eq("Argument description", attrib.Description); - - attrib = cast cs.system.Attribute.GetCustomAttribute(cls.GetMethod("argumentDescription").GetParameters()[0], attribType,true); - t(attrib != null); - eq("Type description test", attrib.Description); - } - - public function testEvents() - { - var x = new haxe.test.MyClass(); - var hasFired = false; - f(hasFired); - var fn:haxe.test.VoidVoid = function() hasFired = true; - x.add_voidvoid( fn ); - f(hasFired); - x.dispatch(); - t(hasFired); - hasFired = false; - x.dispatch(); - t(hasFired); - hasFired = false; - x.remove_voidvoid( fn ); - x.dispatch(); - f(hasFired); - - var hasFired = false; - f(hasFired); - var fn:haxe.test.VoidVoid = function() hasFired = true; - haxe.test.MyClass.add_voidvoid2( fn ); - f(hasFired); - haxe.test.MyClass.dispatch2(); - t(hasFired); - hasFired = false; - haxe.test.MyClass.dispatch2(); - t(hasFired); - hasFired = false; - haxe.test.MyClass.remove_voidvoid2( fn ); - haxe.test.MyClass.dispatch2(); - f(hasFired); - } - - function testHaxeEvents() { - var c = new EventClass(); - var sum = 0; - var cb:Action_1 = function(x) sum += x; - c.add_Event1(cb); - c.invokeEvent1(1); - c.invokeEvent1(2); - c.remove_Event1(cb); - c.invokeEvent1(3); - eq(sum, 3); - - c.add_Event2(cb); - eq(c.event2Counter, 1); - c.remove_Event2(cb); - eq(c.event2Counter, 0); - - sum = 0; - EventClass.add_SEvent1(cb); - EventClass.invokeSEvent1(1); - EventClass.invokeSEvent1(2); - EventClass.remove_SEvent1(cb); - EventClass.invokeSEvent1(3); - eq(sum, 3); - - EventClass.add_SEvent2(cb); - eq(EventClass.sEvent2Counter, 1); - EventClass.remove_SEvent2(cb); - eq(EventClass.sEvent2Counter, 0); - - var i:IEventIface = c; - sum = 0; - i.add_IfaceEvent1(cb); - c.invokeIfaceEvent1(1); - c.invokeIfaceEvent1(2); - i.remove_IfaceEvent1(cb); - c.invokeIfaceEvent1(3); - eq(sum, 3); - - i.add_IfaceEvent2(cb); - eq(c.ifaceEvent2Counter, 1); - i.remove_IfaceEvent2(cb); - eq(c.ifaceEvent2Counter, 0); - } - -#if unsafe - - @:unsafe public function testUnsafe() - { - var x:cs.NativeArray = new cs.NativeArray(10); - cs.Lib.fixed({ - var p = cs.Lib.pointerOfArray(x); - for (i in 0...10) - { - p[0] = i; - p = p.add(1); - } - }); - - cs.Lib.fixed( { - var p = cs.Lib.pointerOfArray(x); - for (i in 0...10) - { - eq(p[i], i); - } - }); - - var x:Int = 0; - var addr = cs.Lib.addressOf(x); - eq(cs.Lib.valueOf(addr), 0); - eq(addr[0], 0); - addr[0] = 42; - eq(cs.Lib.valueOf(addr), 42); - eq(addr[0], 42); - eq(x, 42); - - - } - -#end - - // test these because C# generator got a special filter for these expressions - public function testNullConstEq() - { - var a:Null = 10; - f(a == null); - f(null == a); - t(a != null); - t(null != a); - } - -#end -} - -@:nativeGen private class NativeClass -{ - public var test:Int; - public function outTest(out:cs.Out, x:Int):Void - { - out = x * 2; - } - - public function refTest(i:cs.Ref):Void - { - i *= 2; - } -} - -@:strict(DescriptionAttribute("Type description test")) -typedef StringWithDescription = String; - -private class HxClass extends NativeClass -{ - - public function new() - { - - } - - //here it would normally fail due to the added fast reflection field - override public function outTest(out:cs.Out, x:Int):Void - { - out = x * 4; - } - - override public function refTest(i:cs.Ref):Void - { - super.refTest(i); - i *= 2; - } -} - -@:strict(cs.system.componentmodel.DescriptionAttribute("MyClass Description")) -private class TestMyClass extends haxe.test.MyClass -{ - @:overload public function new() - { - super(); - } - - @:overload public function new(str:String) - { - super(); - alternativeCtorCalled = true; - } - - public var alternativeCtorCalled:Bool; - public var boolCalled:Bool; - public var intCalled:Bool; - public var int64Called:Bool; - public var stringCalled:Bool; - public var dynamicCalled:Bool; - public var getCalled:Bool; - - @:strict(DescriptionAttribute("Argument description")) - @:keep public function argumentDescription(arg:StringWithDescription) - { - } - - @:overload override public function normalOverload(b:Bool):Void - { - this.boolCalled = true; - } - - @:overload override public function normalOverload(i:Int):Void - { - this.intCalled = true; - } - - @:overload override public function normalOverload(i64:haxe.Int64):Void - { - this.int64Called = true; - } - - @:overload override public function normalOverload(str:String):Void - { - this.stringCalled = true; - } - - @:overload override public function normalOverload(dyn:Dynamic):Void - { - this.dynamicCalled = true; - } - - @:overload override public function get_SomeProp():Int - { - getCalled = true; - return 21; - } - - @:overload override public function get_SomeProp2():Int - { - return Std.int(super.get_SomeProp2() / 2); - } -} - -@:struct @:nativeGen private class SomeStruct -{ - public var int:Int; - public var float:Float; - - public function new(i,f) - { - this.int = i; - this.float = f; - } -} - -private interface IEventIface { - @:keep - @:event private var IfaceEvent1:Action_1; - function add_IfaceEvent1(cb:Action_1):Void; - function remove_IfaceEvent1(cb:Action_1):Void; - - @:keep - @:event private var IfaceEvent2:Action_1; - function add_IfaceEvent2(cb:Action_1):Void; - function remove_IfaceEvent2(cb:Action_1):Void; -} - -@:publicFields -private class EventClass implements IEventIface { - function new() {} - - @:event private var Event1:Action_1; - function add_Event1(cb:Action_1) {} - function remove_Event1(cb:Action_1) {} - function invokeEvent1(i) if (Event1 != null) Event1.Invoke(i); - - @:keep - @:event private var Event2:Action_1; - var event2Counter = 0; - function add_Event2(cb:Action_1) event2Counter++; - function remove_Event2(cb:Action_1) event2Counter--; - - @:event private static var SEvent1:Action_1; - static function add_SEvent1(cb:Action_1) {} - static function remove_SEvent1(cb:Action_1) {} - static function invokeSEvent1(i) if (SEvent1 != null) SEvent1.Invoke(i); - - @:keep - @:event private static var SEvent2:Action_1; - static var sEvent2Counter = 0; - static function add_SEvent2(cb:Action_1) sEvent2Counter++; - static function remove_SEvent2(cb:Action_1) sEvent2Counter--; - - @:event private var IfaceEvent1:Action_1; - function add_IfaceEvent1(cb:Action_1) {} - function remove_IfaceEvent1(cb:Action_1) {} - function invokeIfaceEvent1(i) if (IfaceEvent1 != null) IfaceEvent1.Invoke(i); - - @:event private var IfaceEvent2:Action_1; - var ifaceEvent2Counter = 0; - function add_IfaceEvent2(cb:Action_1) ifaceEvent2Counter++; - function remove_IfaceEvent2(cb:Action_1) ifaceEvent2Counter--; -} diff --git a/tests/unit/src/unit/TestConstrainedMonomorphs.hx b/tests/unit/src/unit/TestConstrainedMonomorphs.hx index 92150e7ed0a..bda8c42535a 100644 --- a/tests/unit/src/unit/TestConstrainedMonomorphs.hx +++ b/tests/unit/src/unit/TestConstrainedMonomorphs.hx @@ -18,7 +18,7 @@ private class MyNotString { } } -#if java +#if jvm @:native("unit.DetectiveHaxeExtern") extern private class DetectiveHaxeExtern { overload static function itWasYou(i1:Int, i2:Int):String; @@ -64,7 +64,7 @@ class TestConstrainedMonomorphs extends Test { eq("fooFOO", infer(new MyNotString("foo"))); } - #if java + #if jvm function testDetectiveHaxe() { var a = null; eq("nullfoo", DetectiveHaxeExtern.itWasYou(a, "foo")); @@ -121,4 +121,4 @@ class TestConstrainedMonomorphs extends Test { } #end -} \ No newline at end of file +} diff --git a/tests/unit/src/unit/TestDCE.hx b/tests/unit/src/unit/TestDCE.hx index 7ae3e2595f0..054758dfecb 100644 --- a/tests/unit/src/unit/TestDCE.hx +++ b/tests/unit/src/unit/TestDCE.hx @@ -169,7 +169,7 @@ class TestDCE extends Test { } // TODO: this should be possible in lua - #if (!cpp && !java && !cs && !lua) + #if (!cpp && !jvm && !lua) public function testProperty2() { var a = new RemovePropertyKeepAccessors(); a.test = 3; diff --git a/tests/unit/src/unit/TestExceptions.hx b/tests/unit/src/unit/TestExceptions.hx index 385af032b13..d4bd4780cbd 100644 --- a/tests/unit/src/unit/TestExceptions.hx +++ b/tests/unit/src/unit/TestExceptions.hx @@ -23,17 +23,15 @@ private class CustomNativeException extends php.Exception {} private class CustomNativeException extends js.lib.Error {} #elseif flash private class CustomNativeException extends flash.errors.Error {} -#elseif java +#elseif jvm private class CustomNativeException extends java.lang.RuntimeException {} -#elseif cs -private class CustomNativeException extends cs.system.Exception {} #elseif python private class CustomNativeException extends python.Exceptions.Exception {} #elseif (lua || eval || neko || hl || cpp) private class CustomNativeException { public function new(m:String) {} } #end -#if java +#if jvm private class NativeExceptionBase extends java.lang.RuntimeException {} private class NativeExceptionChild extends NativeExceptionBase {} private class NativeExceptionOther extends java.lang.RuntimeException {} @@ -383,7 +381,7 @@ class TestExceptions extends Test { } } -#if java +#if jvm function testCatchChain() { eq("caught NativeExceptionChild: msg", raise(() -> throw new NativeExceptionChild("msg"))); eq("caught NativeExceptionBase: msg", raise(() -> throw new NativeExceptionBase("msg"))); diff --git a/tests/unit/src/unit/TestInterface.hx b/tests/unit/src/unit/TestInterface.hx index 07869af4462..83b6b2dc64f 100644 --- a/tests/unit/src/unit/TestInterface.hx +++ b/tests/unit/src/unit/TestInterface.hx @@ -33,7 +33,7 @@ private class Point implements IX implements IY { return x; } - public function getY() : #if java /* see https://github.com/HaxeFoundation/haxe/issues/6486 */ Float #else Int #end { + public function getY() : Int { return y; } @@ -95,4 +95,4 @@ class TestInterface extends Test { eq(i2, c); eq(i1,i2); } -} \ No newline at end of file +} diff --git a/tests/unit/src/unit/TestJava.hx b/tests/unit/src/unit/TestJava.hx index 02a7d9cf1e5..ba03ec5238a 100644 --- a/tests/unit/src/unit/TestJava.hx +++ b/tests/unit/src/unit/TestJava.hx @@ -13,7 +13,7 @@ import haxe.test.TEnum; import java.util.EnumSet; import java.vm.*; -#if java +#if jvm @:strict(haxe.test.MyClass.MyClass_MyAnnotation({author: "John Doe", someEnum: TB})) @:strict(MyClass_ParameterLessAnnotation) class TestJava extends Test { diff --git a/tests/unit/src/unit/TestMain.hx b/tests/unit/src/unit/TestMain.hx index 044bfd3f0ee..71163d46607 100644 --- a/tests/unit/src/unit/TestMain.hx +++ b/tests/unit/src/unit/TestMain.hx @@ -27,10 +27,6 @@ function main() { var verbose = #if (cpp || neko || php) Sys.args().indexOf("-v") >= 0 #else false #end; - #if cs // "Turkey Test" - Issue #996 - cs.system.threading.Thread.CurrentThread.CurrentCulture = new cs.system.globalization.CultureInfo('tr-TR'); - cs.Lib.applyCultureChanges(); - #end TestMainNow.printNow(); trace("START"); #if flash @@ -73,10 +69,7 @@ function main() { #if !no_pattern_matching new TestMatch(), #end - #if cs - new TestCSharp(), - #end - #if java + #if jvm new TestJava(), #end #if lua @@ -91,7 +84,7 @@ function main() { #if php new TestPhp(), #end - #if (java || cs) + #if jvm new TestOverloads(), #end new TestOverloadsForEveryone(), diff --git a/tests/unit/src/unit/TestMisc.hx b/tests/unit/src/unit/TestMisc.hx index dc023ba45ac..12750493311 100644 --- a/tests/unit/src/unit/TestMisc.hx +++ b/tests/unit/src/unit/TestMisc.hx @@ -1,5 +1,4 @@ -package unit; - +package unit; import unit.MyClass; class MyDynamicClass { @@ -281,11 +280,9 @@ class TestMisc extends Test { // check inherited dynamic method var inst = new MyOtherDynamicClass(0); var add = inst.add; - #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 + eq( inst.add(1,2), 13 ); + eq( inst.add.bind(1)(2), 13 ); + eq( add(1,2), 13 ); // check static dynamic eq(MyDynamicClass.staticDynamic(1, 2), 13); @@ -385,7 +382,7 @@ class TestMisc extends Test { eq(opt2().x, 5); eq(opt2().y, "hello"); - #if !(flash || cpp || cs || java) + #if !(flash || cpp || jvm) eq(opt2(null, null).x, 5); #end eq(opt2(0, null).y, "hello"); diff --git a/tests/unit/src/unit/TestNullCoalescing.hx b/tests/unit/src/unit/TestNullCoalescing.hx index e6965b7ebcd..76eb4895fbc 100644 --- a/tests/unit/src/unit/TestNullCoalescing.hx +++ b/tests/unit/src/unit/TestNullCoalescing.hx @@ -119,7 +119,6 @@ class TestNullCoalescing extends Test { eq(arr[i], v); final arr = []; - #if !cs function item(n) { arr.push(n); return null; @@ -128,7 +127,6 @@ class TestNullCoalescing extends Test { eq(arr.length, 3); for (i => v in [1, 2, 3]) eq(arr[i], v); - #end var b:B = cast null; var c:C = cast null; diff --git a/tests/unit/src/unit/TestNumericCasts.hx b/tests/unit/src/unit/TestNumericCasts.hx index 5a53fde0e6f..d5b7134e846 100644 --- a/tests/unit/src/unit/TestNumericCasts.hx +++ b/tests/unit/src/unit/TestNumericCasts.hx @@ -1,6 +1,6 @@ // This file is auto-generated from RunCastGenerator.hx - do not edit! package unit; -#if java +#if jvm import java.StdTypes; private typedef Int32 = Int; private typedef Float32 = Single; diff --git a/tests/unit/src/unit/TestOverloads.hx b/tests/unit/src/unit/TestOverloads.hx index 59e3161a5f7..f433613e2ab 100644 --- a/tests/unit/src/unit/TestOverloads.hx +++ b/tests/unit/src/unit/TestOverloads.hx @@ -151,12 +151,12 @@ class TestOverloads extends Test eq(Primitives.prim(nf, null), "Null"); var dyn:Dynamic = null; eq(Primitives.prim(dyn), "Dynamic"); -#if (java || cs) + #if jvm var s:Single = 1.0; eq(Primitives.prim(s), "Single" ); var ns:Null = null; eq(Primitives.prim(ns, null), "Null"); -#end + #end } //former java tests. only exact types @@ -251,7 +251,7 @@ private class Primitives return "Null"; } -#if (java || cs) + #if jvm overload public static function prim(v:Single):String { return "Single"; @@ -266,7 +266,7 @@ private class Primitives { return "Null"; } -#end + #end } private interface I0 diff --git a/tests/unit/src/unit/TestReflect.hx b/tests/unit/src/unit/TestReflect.hx index 3455291e4ac..483cbfebba4 100644 --- a/tests/unit/src/unit/TestReflect.hx +++ b/tests/unit/src/unit/TestReflect.hx @@ -225,8 +225,8 @@ class TestReflect extends Test { eq( i.intValue, 55 ); var i = Type.createEmptyInstance(MyClass); t( (i is MyClass) ); - eq( i.get(), #if (flash || cpp || java || cs || hl) 0 #else null #end ); - eq( i.intValue, #if (flash || cpp || java || cs || hl) 0 #else null #end ); + eq( i.get(), #if (flash || cpp || jvm || hl) 0 #else null #end ); + eq( i.intValue, #if (flash || cpp || jvm || hl) 0 #else null #end ); var e : MyEnum = Type.createEnum(MyEnum,__unprotect__("A")); eq( e, MyEnum.A ); var e : MyEnum = Type.createEnum(MyEnum,__unprotect__("C"),[55,"hello"]); diff --git a/tests/unit/src/unit/TestSyntaxModule.hx b/tests/unit/src/unit/TestSyntaxModule.hx index e04e3a6d069..4ead9f0eda3 100644 --- a/tests/unit/src/unit/TestSyntaxModule.hx +++ b/tests/unit/src/unit/TestSyntaxModule.hx @@ -6,12 +6,10 @@ import js.Syntax; import php.Syntax; #elseif python import python.Syntax; -#elseif cs -import cs.Syntax; #end class TestSyntaxModule extends Test { -#if (php || js || python || cs) +#if (php || js || python) function testCode() { var i1 = 1; var i2 = 2; @@ -53,7 +51,7 @@ class TestSyntaxModule extends Test { #end #end -#if (js || cs) +#if js function testPlainCode() { var s = Syntax.plainCode('"{0}"'); eq('{0}', s); diff --git a/tests/unit/src/unit/TestType.hx b/tests/unit/src/unit/TestType.hx index 7964aa937cb..047ce8d32b8 100644 --- a/tests/unit/src/unit/TestType.hx +++ b/tests/unit/src/unit/TestType.hx @@ -427,7 +427,7 @@ class TestType extends Test { //typeError(pcc.memberAnon( { x : 1 } )); //typeError(pcc.memberAnon( { y : 3. } )); - #if !(java || cs) + #if !jvm // pcc.memberOverload("foo", "bar"); #end // TODO: this should not fail (overload accepts) diff --git a/tests/unit/src/unit/issues/Issue10143.hx b/tests/unit/src/unit/issues/Issue10143.hx index 9ee4fcc1057..211ce556235 100644 --- a/tests/unit/src/unit/issues/Issue10143.hx +++ b/tests/unit/src/unit/issues/Issue10143.hx @@ -1,7 +1,7 @@ package unit.issues; //targets with pf_supports_rest_args = true -#if (js || lua || php || cs || java || python || flash) +#if (js || lua || php || jvm || python || flash) class Issue10143 extends Test { function test1() { @@ -31,4 +31,4 @@ private abstract AObj({field:String}) from {field:String} { #else class Issue10143 extends Test {} -#end \ No newline at end of file +#end diff --git a/tests/unit/src/unit/issues/Issue10145.hx b/tests/unit/src/unit/issues/Issue10145.hx index 5a61bd91e2c..8ed035f2ba2 100644 --- a/tests/unit/src/unit/issues/Issue10145.hx +++ b/tests/unit/src/unit/issues/Issue10145.hx @@ -1,7 +1,5 @@ package unit.issues; -// whatever -#if !erase_generics private interface I { function get():T; } @@ -30,14 +28,11 @@ private abstract A(I) { return this.get(); } } -#end class Issue10145 extends unit.Test { - #if !erase_generics function test() { var x = new A(10); var y:Int = x; eq(10, y); } - #end } diff --git a/tests/unit/src/unit/issues/Issue10193.hx b/tests/unit/src/unit/issues/Issue10193.hx index 3c4d464db01..44001d2f462 100644 --- a/tests/unit/src/unit/issues/Issue10193.hx +++ b/tests/unit/src/unit/issues/Issue10193.hx @@ -1,7 +1,7 @@ package unit.issues; class Issue10193 extends Test { - #if (js || (cs && !no_root) || java) + #if (js || jvm) function test() { var c = new C(42); eq(42, c.a); @@ -10,7 +10,7 @@ class Issue10193 extends Test { #end } -#if (js || (cs && !no_root) || java) // some targets are not happy with this for some reason... +#if (js || jvm) // some targets are not happy with this for some reason... @:keep @:native("Issue10193E") private class EImpl { diff --git a/tests/unit/src/unit/issues/Issue10508.hx b/tests/unit/src/unit/issues/Issue10508.hx index ed8a5b74a0a..9a1b9645bae 100644 --- a/tests/unit/src/unit/issues/Issue10508.hx +++ b/tests/unit/src/unit/issues/Issue10508.hx @@ -1,7 +1,7 @@ package unit.issues; class Issue10508 extends Test { - #if java + #if jvm function test() { t(java.math.RoundingMode.getConstructors().length > 0); t(java.math.RoundingMode.createAll().length > 0); diff --git a/tests/unit/src/unit/issues/Issue10571.hx b/tests/unit/src/unit/issues/Issue10571.hx index f6853d40d12..003e931f23f 100644 --- a/tests/unit/src/unit/issues/Issue10571.hx +++ b/tests/unit/src/unit/issues/Issue10571.hx @@ -1,7 +1,7 @@ package unit.issues; class Issue10571 extends Test { - #if java + #if jvm function test() { eq("test()", foo()); eq("test(I)", foo(1)); diff --git a/tests/unit/src/unit/issues/Issue10618.hx b/tests/unit/src/unit/issues/Issue10618.hx index 39f317977b8..c46b66e8a68 100644 --- a/tests/unit/src/unit/issues/Issue10618.hx +++ b/tests/unit/src/unit/issues/Issue10618.hx @@ -1,6 +1,6 @@ package unit.issues; -#if java +#if jvm @:keep private class NotMain implements java.util.Iterator { static function main() {} diff --git a/tests/unit/src/unit/issues/Issue10761.hx b/tests/unit/src/unit/issues/Issue10761.hx index b5bebbd457b..634b5a3335d 100644 --- a/tests/unit/src/unit/issues/Issue10761.hx +++ b/tests/unit/src/unit/issues/Issue10761.hx @@ -7,11 +7,9 @@ class Issue10761 extends Test { return args; } - #if !erase_generics function test() { aeq([0, 1], rest(0, 1)); // works aeq([0, 1], rest(...[0, 1])); // works aeq([0, 1], rest(...[for (i in 0...2) i])); // errors } - #end } diff --git a/tests/unit/src/unit/issues/Issue10906.hx b/tests/unit/src/unit/issues/Issue10906.hx index 7653a5ebe4c..e7eae7aeca5 100644 --- a/tests/unit/src/unit/issues/Issue10906.hx +++ b/tests/unit/src/unit/issues/Issue10906.hx @@ -4,7 +4,6 @@ import haxe.Rest; import utest.Assert; class Issue10906 extends Test { - #if !erase_generics function test() { var a:Array = new Array(); a.push(1); @@ -16,5 +15,4 @@ class Issue10906 extends Test { eq(1, r[0]); eq(3, r.length); } - #end } diff --git a/tests/unit/src/unit/issues/Issue11010.hx b/tests/unit/src/unit/issues/Issue11010.hx index de2be91b9b1..613b9f9c083 100644 --- a/tests/unit/src/unit/issues/Issue11010.hx +++ b/tests/unit/src/unit/issues/Issue11010.hx @@ -34,7 +34,7 @@ class ExampleGeneric extends ExampleAbstract> { } class Issue11010 extends Test { - #if (!cs && !cppia) + #if (!cppia) function test() { var test = new ExampleGeneric([1, 2, 3, 4]); utest.Assert.same([1, 2, 3, 4], test.value); diff --git a/tests/unit/src/unit/issues/Issue1925.hx b/tests/unit/src/unit/issues/Issue1925.hx index a799a36b3d4..17441411518 100644 --- a/tests/unit/src/unit/issues/Issue1925.hx +++ b/tests/unit/src/unit/issues/Issue1925.hx @@ -1,18 +1,16 @@ package unit.issues; -#if java +#if jvm import java.NativeArray; -#elseif cs -import cs.NativeArray; #end class Issue1925 extends Test { -#if (java || cs) - static var d2:Array>; +#if jvm + static var d2:Array>; function test() { - var d = new NativeArray(10); - d2 = [d]; - d[0] = 10; - eq(d2[0][0], 10); + var d = new NativeArray(10); + d2 = [d]; + d[0] = 10; + eq(d2[0][0], 10); } #end } diff --git a/tests/unit/src/unit/issues/Issue2049.hx b/tests/unit/src/unit/issues/Issue2049.hx index eb81eaa519b..e9dfdedb4ad 100644 --- a/tests/unit/src/unit/issues/Issue2049.hx +++ b/tests/unit/src/unit/issues/Issue2049.hx @@ -1,15 +1,12 @@ package unit.issues; -#if cs -import cs.NativeArray; -import cs.Lib; -#elseif java +#if jvm import java.NativeArray; import java.Lib; #end class Issue2049 extends unit.Test { -#if (java || cs) +#if jvm public function test() { var arr = [ 1., 1., 1., 0.5 ].map( function( n: Float ): Single { return n; }); @@ -20,5 +17,4 @@ class Issue2049 extends unit.Test eq(.5,scaleFactors[3]); } #end - } diff --git a/tests/unit/src/unit/issues/Issue2648.hx b/tests/unit/src/unit/issues/Issue2648.hx index 18b21d49b3a..525179e969c 100644 --- a/tests/unit/src/unit/issues/Issue2648.hx +++ b/tests/unit/src/unit/issues/Issue2648.hx @@ -1,7 +1,7 @@ package unit.issues; import unit.Test; -#if java +#if jvm private class TestParam { @:overload static public function forName(s:Int) { } @:overload static public function forName(s:String) { } @@ -9,7 +9,7 @@ private class TestParam { #end class Issue2648 extends Test { - #if java + #if jvm function test() { TestParam.forName(1); TestParam.forName("s"); diff --git a/tests/unit/src/unit/issues/Issue2688.hx b/tests/unit/src/unit/issues/Issue2688.hx index 1f1a51b6eba..e63be562ca8 100644 --- a/tests/unit/src/unit/issues/Issue2688.hx +++ b/tests/unit/src/unit/issues/Issue2688.hx @@ -1,7 +1,7 @@ package unit.issues; class Issue2688 extends Test { -#if (java || cs) +#if jvm public function test() { var x = 0; var b = new B(function() { @@ -13,7 +13,7 @@ class Issue2688 extends Test { #end } -#if (java || cs) +#if jvm @:nativeGen private class A { public function new() { diff --git a/tests/unit/src/unit/issues/Issue2754.hx b/tests/unit/src/unit/issues/Issue2754.hx index 1c7d5afe1bc..eb41e6be056 100644 --- a/tests/unit/src/unit/issues/Issue2754.hx +++ b/tests/unit/src/unit/issues/Issue2754.hx @@ -2,7 +2,7 @@ package unit.issues; class Issue2754 extends unit.Test { -#if (cs || java) +#if jvm public function testClass() { var tc = new TestClass(); diff --git a/tests/unit/src/unit/issues/Issue2772.hx b/tests/unit/src/unit/issues/Issue2772.hx index 5f2bba6f362..d81e0e29e3c 100644 --- a/tests/unit/src/unit/issues/Issue2772.hx +++ b/tests/unit/src/unit/issues/Issue2772.hx @@ -2,7 +2,7 @@ package unit.issues; class Issue2772 extends Test { -#if java +#if jvm public function test() { var f = false; diff --git a/tests/unit/src/unit/issues/Issue2776.hx b/tests/unit/src/unit/issues/Issue2776.hx index 5520b5e56ef..deaf8b7e822 100644 --- a/tests/unit/src/unit/issues/Issue2776.hx +++ b/tests/unit/src/unit/issues/Issue2776.hx @@ -25,11 +25,11 @@ class Issue2776 extends Test { })); } - static function getClassT():#if cs Class #else Null> #end { + static function getClassT():Null> { return (null : Class); } - static function getEnumT():#if cs Enum #else Null> #end { + static function getEnumT():Null> { return (null : Enum); } } diff --git a/tests/unit/src/unit/issues/Issue2861.hx b/tests/unit/src/unit/issues/Issue2861.hx index 6ab652815df..442b0d642b7 100644 --- a/tests/unit/src/unit/issues/Issue2861.hx +++ b/tests/unit/src/unit/issues/Issue2861.hx @@ -2,7 +2,7 @@ package unit.issues; class Issue2861 extends Test { -#if (flash || neko || cpp || java || php || hl) +#if (flash || neko || cpp || jvm || php || hl) public function test() { var b = haxe.io.Bytes.alloc(2048); diff --git a/tests/unit/src/unit/issues/Issue2927.hx b/tests/unit/src/unit/issues/Issue2927.hx index 5a0088b8496..17c786e3f97 100644 --- a/tests/unit/src/unit/issues/Issue2927.hx +++ b/tests/unit/src/unit/issues/Issue2927.hx @@ -1,14 +1,11 @@ package unit.issues; -#if java +#if jvm import java.Lib; import java.NativeArray; -#elseif cs -import cs.Lib; -import cs.NativeArray; #end class Issue2927 extends Test { -#if (java || cs) +#if jvm public function test() { var arr = Lib.array(new NativeArray(1)); diff --git a/tests/unit/src/unit/issues/Issue3084.hx b/tests/unit/src/unit/issues/Issue3084.hx index 26b05c1a15e..fca1a8ae651 100644 --- a/tests/unit/src/unit/issues/Issue3084.hx +++ b/tests/unit/src/unit/issues/Issue3084.hx @@ -3,7 +3,7 @@ import unit.Test; class Issue3084 extends Test { -#if java +#if jvm function test() { for (i in 0...40) diff --git a/tests/unit/src/unit/issues/Issue3138.hx b/tests/unit/src/unit/issues/Issue3138.hx index b0bd8af74ba..78396f9c4d5 100644 --- a/tests/unit/src/unit/issues/Issue3138.hx +++ b/tests/unit/src/unit/issues/Issue3138.hx @@ -5,7 +5,7 @@ class Issue3138 extends Test public function test() { var a = new B(); -#if (java || cs) +#if jvm var b = new D(); #end noAssert(); @@ -18,11 +18,11 @@ private class A { private class B extends A { public function new(?a = 1) { - super(a); // error CS0030: Cannot convert type 'int' to 'haxe.lang.Null' + super(a); } } -#if (cs || java) +#if jvm private class C { public function new(a) {} @@ -30,7 +30,7 @@ private class C { private class D extends C { public function new(?a:Single = 1) { - super(a); // error CS0030: Cannot convert type 'int' to 'haxe.lang.Null' + super(a); } } diff --git a/tests/unit/src/unit/issues/Issue3171.hx b/tests/unit/src/unit/issues/Issue3171.hx index 0981ac95b39..5607150d6ce 100644 --- a/tests/unit/src/unit/issues/Issue3171.hx +++ b/tests/unit/src/unit/issues/Issue3171.hx @@ -2,7 +2,7 @@ package unit.issues; class Issue3171 extends Test { -#if (java || cs) +#if jvm public function test() { var oint = new O2(); @@ -22,7 +22,7 @@ class Issue3171 extends Test } #end } -#if (java || cs) +#if jvm class O { public var lastVal = 0; diff --git a/tests/unit/src/unit/issues/Issue3173.hx b/tests/unit/src/unit/issues/Issue3173.hx index b337c2b5708..114e37a4433 100644 --- a/tests/unit/src/unit/issues/Issue3173.hx +++ b/tests/unit/src/unit/issues/Issue3173.hx @@ -1,7 +1,7 @@ package unit.issues; import haxe.ds.StringMap; -#if (java || cs) +#if jvm class Issue3173 extends Test { @@ -20,7 +20,7 @@ private class O2 extends O> { } -#if (java || cs) +#if jvm @:overload #end override public function foo(t:StringMap):Int @@ -31,7 +31,7 @@ private class O2 extends O> private class O { -#if (java || cs) +#if jvm @:overload #end public function foo(t:T):Int @@ -44,4 +44,4 @@ private class O class Issue3173 extends Test { } -#end \ No newline at end of file +#end diff --git a/tests/unit/src/unit/issues/Issue3306.hx b/tests/unit/src/unit/issues/Issue3306.hx index d5992404167..8a70781e637 100644 --- a/tests/unit/src/unit/issues/Issue3306.hx +++ b/tests/unit/src/unit/issues/Issue3306.hx @@ -1,11 +1,11 @@ package unit.issues; -#if (java || cs) +#if jvm typedef Float32 = Single; #end class Issue3306 extends Test { -#if (java || cs) +#if jvm function test() { var iw:Float32 = 0.0; var iw2:Float32; diff --git a/tests/unit/src/unit/issues/Issue3383.hx b/tests/unit/src/unit/issues/Issue3383.hx deleted file mode 100644 index e73984b8a02..00000000000 --- a/tests/unit/src/unit/issues/Issue3383.hx +++ /dev/null @@ -1,29 +0,0 @@ -package unit.issues; - -class Issue3383 extends Test { -#if cs - function test() { - var i:Int = cast null, - f:Float = cast null, - s:Single = cast null, - i64:haxe.Int64 = cast null, - span:cs.system.TimeSpan = null, - ui:UInt = cast null, - n:cs.system.Nullable_1 = null; - - #if !(erase_generics && !fast_cast) - eq(i, cast null); - eq(f, cast null); - eq(s, cast null); - eq(i64, cast null); - eq(span, null); - eq(ui, cast null); - eq(n, null); - #else - Sys.stderr().writeString("https://github.com/HaxeFoundation/haxe/issues/5503 pending\n"); - noAssert(); - #end - } -#end -} - diff --git a/tests/unit/src/unit/issues/Issue3396.hx b/tests/unit/src/unit/issues/Issue3396.hx index c6f91d8b1e6..e85ac36117b 100644 --- a/tests/unit/src/unit/issues/Issue3396.hx +++ b/tests/unit/src/unit/issues/Issue3396.hx @@ -8,11 +8,7 @@ class Issue3396 extends Test { Reflect.makeVarArgs(f); Reflect.makeVarArgs(f2); var s:String = f([]); - #if cs - unit.HelperMacros.typedAs(r, (r : String)); - #else unit.HelperMacros.typedAs(r, (r : Null)); - #end unit.HelperMacros.typedAs(f2([]), (null : Void)); } } diff --git a/tests/unit/src/unit/issues/Issue3400.hx b/tests/unit/src/unit/issues/Issue3400.hx index 7efa1a13704..17e7f8c93f4 100644 --- a/tests/unit/src/unit/issues/Issue3400.hx +++ b/tests/unit/src/unit/issues/Issue3400.hx @@ -2,7 +2,7 @@ package unit.issues; class Issue3400 extends Test { -#if java +#if jvm public function test() { var a:AbstractList = AbstractList.empty(); @@ -11,7 +11,7 @@ class Issue3400 extends Test #end } -#if java +#if jvm private abstract AbstractList(java.util.ArrayList) { function new(a:T) diff --git a/tests/unit/src/unit/issues/Issue3558.hx b/tests/unit/src/unit/issues/Issue3558.hx deleted file mode 100644 index 568eb5e567d..00000000000 --- a/tests/unit/src/unit/issues/Issue3558.hx +++ /dev/null @@ -1,37 +0,0 @@ -package unit.issues; -#if cs -import cs.system.collections.generic.*; -import cs.system.collections.*; -#end - -class Issue3558 extends Test -{ -#if cs - public function test() - { - var dict = new Dictionary_2(); - dict[10] = "11"; - var e:IDictionaryEnumerator = dict.GetEnumerator(); - while (e.MoveNext()) - { - eq(e.Key,10); - eq(e.Value,"11"); - } - var e = dict.GetEnumerator(); - while (e.MoveNext()) - { - var cur = e.Current; - eq(cur.Key,10); - eq(cur.Value,"11"); - } - - var en = dict.Values.GetEnumerator(); - while (en.MoveNext()) - { - var cur = en.Current; - eq(cur,"11"); - } - } -#end - -} diff --git a/tests/unit/src/unit/issues/Issue3575.hx b/tests/unit/src/unit/issues/Issue3575.hx index bc7e6391167..4a19d84a443 100644 --- a/tests/unit/src/unit/issues/Issue3575.hx +++ b/tests/unit/src/unit/issues/Issue3575.hx @@ -10,13 +10,13 @@ class Issue3575 extends Test { #if !cpp @:nativeGen #end private class Base { -#if (cs || java) @:overload #end +#if jvm @:overload #end public function getName() { return "Base!"; } -#if (cs || java) +#if jvm @:overload public function getName(s:String) { return 'Base!:$s'; @@ -35,7 +35,7 @@ class Child extends DirectDescendant { } -#if (cs || java) @:overload #end +#if jvm @:overload #end override public function getName() { return "Something Else"; diff --git a/tests/unit/src/unit/issues/Issue3579.hx b/tests/unit/src/unit/issues/Issue3579.hx index eff21a5919d..79ab9f3b161 100644 --- a/tests/unit/src/unit/issues/Issue3579.hx +++ b/tests/unit/src/unit/issues/Issue3579.hx @@ -31,6 +31,6 @@ private class SomeClass } } -#if (!java && !cs) +#if (!jvm) private typedef Single = Float #end diff --git a/tests/unit/src/unit/issues/Issue3637.hx b/tests/unit/src/unit/issues/Issue3637.hx index decaf525820..dbbe0c38506 100644 --- a/tests/unit/src/unit/issues/Issue3637.hx +++ b/tests/unit/src/unit/issues/Issue3637.hx @@ -17,13 +17,10 @@ class Issue3637 extends Test { a.push(map[key]); } eq(4, a.length); - // TODO: some separate issue - #if !cs t(Lambda.has(a, "a")); t(Lambda.has(a, "b")); t(Lambda.has(a, 1)); t(a.remove(1)); t(Lambda.has(a, 1)); - #end } -} \ No newline at end of file +} diff --git a/tests/unit/src/unit/issues/Issue3639.hx b/tests/unit/src/unit/issues/Issue3639.hx index dd1320add17..13a59d10779 100644 --- a/tests/unit/src/unit/issues/Issue3639.hx +++ b/tests/unit/src/unit/issues/Issue3639.hx @@ -30,11 +30,8 @@ class Issue3639 extends Test { MyClass.testStatic(1); MyClass.eachStatic(0...5, function(x) return x); - #if !cs - // https://github.com/HaxeFoundation/haxe/issues/3658 hsf(MyClass, "testStatic_Int"); hsf(MyClass, "eachStatic_Int_IntIterator"); - #end var t = new MyClass(); t.testMember(1, "12"); @@ -42,10 +39,8 @@ class Issue3639 extends Test { var t = new MyClass(); t.eachMember(0...5, function(x) return x); - #if !cs hf(MyClass, "testMember_String"); hf(MyClass, "eachMember_IntIterator"); - #end noAssert(); } -} \ No newline at end of file +} diff --git a/tests/unit/src/unit/issues/Issue3771.hx b/tests/unit/src/unit/issues/Issue3771.hx deleted file mode 100644 index ac5fc3b5398..00000000000 --- a/tests/unit/src/unit/issues/Issue3771.hx +++ /dev/null @@ -1,12 +0,0 @@ -package unit.issues; - -class Issue3771 extends Test -{ - #if cs - public function test() - { - var arr = [test]; - eq(arr.indexOf(test),0); - } - #end -} diff --git a/tests/unit/src/unit/issues/Issue3818.hx b/tests/unit/src/unit/issues/Issue3818.hx index 12ac806aa13..2864a0d0948 100644 --- a/tests/unit/src/unit/issues/Issue3818.hx +++ b/tests/unit/src/unit/issues/Issue3818.hx @@ -11,7 +11,7 @@ class Issue3818 extends Test var s1 = "UI/fx/Materials/fx_ui_atlas_icons_additive_mat"; var s2 = "UI/img/bg_info"; var s3 = "art/3d/env/props/city_props/textures/cityprops_debris01"; -#if java +#if jvm //known collisions s1 = "Aa"; s2 = "BB"; diff --git a/tests/unit/src/unit/issues/Issue3826.hx b/tests/unit/src/unit/issues/Issue3826.hx index 8ff0b33bbef..49902746cf2 100644 --- a/tests/unit/src/unit/issues/Issue3826.hx +++ b/tests/unit/src/unit/issues/Issue3826.hx @@ -35,7 +35,7 @@ class Issue3826 extends Test { #end } - #if !((java && !jvm) || cs || flash) + #if !(flash) public function testReflect() { eq( Reflect.callMethod(this, get, []), "2/4.25" ); eq( Reflect.callMethod(this, get, [5]), "5/4.25" ); diff --git a/tests/unit/src/unit/issues/Issue3842.hx b/tests/unit/src/unit/issues/Issue3842.hx index 575df98e475..194a9d65d82 100644 --- a/tests/unit/src/unit/issues/Issue3842.hx +++ b/tests/unit/src/unit/issues/Issue3842.hx @@ -2,7 +2,7 @@ package unit.issues; class Issue3842 extends Test { -#if (cs || java) +#if jvm // public function test() // { // var c = new Child(); @@ -13,7 +13,7 @@ class Issue3842 extends Test #end } // -// #if (cs || java) +// #if jvm // private class Base // { // public function new() diff --git a/tests/unit/src/unit/issues/Issue3894.hx b/tests/unit/src/unit/issues/Issue3894.hx index e9a8ba40ca4..b82de947fc8 100644 --- a/tests/unit/src/unit/issues/Issue3894.hx +++ b/tests/unit/src/unit/issues/Issue3894.hx @@ -2,10 +2,10 @@ package unit.issues; class Issue3894 extends Test { function test() { - #if (flash || cs || java || cpp) + #if (flash || jvm || cpp) // this doesn't actually error until post-processing so we cannot test it like this //t(unit.HelperMacros.typeError((null : haxe.Int64))); #end noAssert(); } -} \ No newline at end of file +} diff --git a/tests/unit/src/unit/issues/Issue3946.hx b/tests/unit/src/unit/issues/Issue3946.hx deleted file mode 100644 index a6c48d6c1dd..00000000000 --- a/tests/unit/src/unit/issues/Issue3946.hx +++ /dev/null @@ -1,12 +0,0 @@ -package unit.issues; - -class Issue3946 extends Test { - #if cs - function test() { - var arr = cs.Lib.arrayAlloc(10); - eq(arr.length, 10); - arr[0] = 5; - eq(arr[0],5); - } - #end -} diff --git a/tests/unit/src/unit/issues/Issue3949.hx b/tests/unit/src/unit/issues/Issue3949.hx deleted file mode 100644 index 08800ef3ade..00000000000 --- a/tests/unit/src/unit/issues/Issue3949.hx +++ /dev/null @@ -1,40 +0,0 @@ -package unit.issues; - -class Issue3949 extends unit.Test { -#if cs - function test() { - var a = new Arr(); - a.arr[0] = this; - checkCastClass(a.arr[0]); - - var a = new Arr(); - a.arr[0] = 10; - checkCastInt(10, a.arr[0]); - - var a = new Arr(); - a.arr[0] = 'hello'; - checkCastString('hello', a.arr[0]); - } - - @:pure(false) - function checkCastClass(v:Issue3949) { - eq(this, v); - } - - @:pure(false) - function checkCastInt(v1:Int, v2:Int) { - eq(v1, v2); - } - - @:pure(false) - function checkCastString(v1:String, v2:String) { - eq(v1, v2); - } -#end -} -#if cs -private class Arr { - public var arr = new cs.NativeArray(1); - public function new() {} -} -#end \ No newline at end of file diff --git a/tests/unit/src/unit/issues/Issue3979.hx b/tests/unit/src/unit/issues/Issue3979.hx index 0c7fc1ef264..bba608ea0d4 100644 --- a/tests/unit/src/unit/issues/Issue3979.hx +++ b/tests/unit/src/unit/issues/Issue3979.hx @@ -1,13 +1,11 @@ package unit.issues; -#if java +#if jvm import java.NativeArray; -#elseif cs -import cs.NativeArray; #end class Issue3979 extends Test { - #if (java || cs) + #if jvm public function test() { var v = 0; diff --git a/tests/unit/src/unit/issues/Issue3987.hx b/tests/unit/src/unit/issues/Issue3987.hx index a571183ef95..6f98e368d55 100644 --- a/tests/unit/src/unit/issues/Issue3987.hx +++ b/tests/unit/src/unit/issues/Issue3987.hx @@ -1,7 +1,7 @@ package unit.issues; class Issue3987 extends Test { -#if java +#if jvm public function test() { var int = java.lang.Integer.valueOf(123); eq(int.intValue(), 123); diff --git a/tests/unit/src/unit/issues/Issue4000.hx b/tests/unit/src/unit/issues/Issue4000.hx index 1045f550128..64514f4e440 100644 --- a/tests/unit/src/unit/issues/Issue4000.hx +++ b/tests/unit/src/unit/issues/Issue4000.hx @@ -10,7 +10,7 @@ class Issue4000 extends Test eq(c.dyn.a,1); eq(c.dyn.b,10); f(c.b); -#if (java || cs) +#if jvm var c = new Child(42); eq(c.i,42); eq(c.f,1.0); @@ -35,7 +35,7 @@ private class Child extends NativeGen public var dyn = { a:1, b:10 }; public var b = true; -#if (java || cs) +#if jvm @:overload #end public function new() @@ -44,7 +44,7 @@ private class Child extends NativeGen this.b = false; } -#if (java || cs) +#if jvm @:overload public function new(i:Float) { super(); diff --git a/tests/unit/src/unit/issues/Issue4045.hx b/tests/unit/src/unit/issues/Issue4045.hx deleted file mode 100644 index 085fa1c8b44..00000000000 --- a/tests/unit/src/unit/issues/Issue4045.hx +++ /dev/null @@ -1,45 +0,0 @@ -package unit.issues; - -class Issue4045 extends Test -{ -#if cs - public function test() - { - var t = new TestS(); - t.a = 10; - eq(10, t.a); - } -#end -} - -#if cs -private abstract TestS(TestClass) -{ - inline public function new() - { - this = new TestClass(0); - } - - public var a(get,set):Int; - - inline private function get_a() - { - return this.a; - } - - inline private function set_a(v:Int) - { - return this.a = v; - } -} - -@:nativeGen @:struct private class TestClass -{ - public var a:Int; - - public function new(av) - { - this.a = av; - } -} -#end diff --git a/tests/unit/src/unit/issues/Issue4203.hx b/tests/unit/src/unit/issues/Issue4203.hx index 57941ccd512..94756c499aa 100644 --- a/tests/unit/src/unit/issues/Issue4203.hx +++ b/tests/unit/src/unit/issues/Issue4203.hx @@ -9,7 +9,7 @@ class Issue4203 extends Test { } } -#if (java || cs) +#if jvm @:nativeGen #end private interface NativeItem { diff --git a/tests/unit/src/unit/issues/Issue4526.hx b/tests/unit/src/unit/issues/Issue4526.hx index 2f94bbc5f30..5899be8c05a 100644 --- a/tests/unit/src/unit/issues/Issue4526.hx +++ b/tests/unit/src/unit/issues/Issue4526.hx @@ -39,7 +39,7 @@ private class Struct4 { class Issue4526 extends Test { function test() { - var fieldNull = #if (cpp || flash || java || cs || hl) 0 #else null #end; + var fieldNull = #if (cpp || flash || jvm || hl) 0 #else null #end; var s1:Struct1 = { x: 12, y: 13 }; eq("12 13", s1.get()); @@ -65,4 +65,4 @@ class Issue4526 extends Test { var s4:Struct4 = { y: i++, x: i++, z: i++ }; eq("1 0 2", s4.get()); } -} \ No newline at end of file +} diff --git a/tests/unit/src/unit/issues/Issue5025.hx b/tests/unit/src/unit/issues/Issue5025.hx index 61870cfccd6..bb5eb362177 100644 --- a/tests/unit/src/unit/issues/Issue5025.hx +++ b/tests/unit/src/unit/issues/Issue5025.hx @@ -6,7 +6,7 @@ class Issue5025 extends Test { } function shouldCompile() { - #if !(java || cs || lua) + #if !lua try { switch (null) { case Value(i): @@ -19,4 +19,4 @@ class Issue5025 extends Test { enum SomeEnum { Value(i:Int); -} \ No newline at end of file +} diff --git a/tests/unit/src/unit/issues/Issue5110.hx.disabled b/tests/unit/src/unit/issues/Issue5110.hx.disabled deleted file mode 100644 index 18aef9d6cfc..00000000000 --- a/tests/unit/src/unit/issues/Issue5110.hx.disabled +++ /dev/null @@ -1,18 +0,0 @@ -package unit.issues; - -class Issue5110 extends Test { - public function test() { -#if cs - var lst:List = cast new cs.system.collections.generic.List_1(); - eq(lst.get_Item(0), 0); -#end - } -} - -#if cs -private abstract List(cs.system.collections.generic.List_1) { - public function get_Item(n:Int):T { - return this.get_Item(n); - } -} -#end diff --git a/tests/unit/src/unit/issues/Issue5399.hx b/tests/unit/src/unit/issues/Issue5399.hx deleted file mode 100644 index 94652fc0938..00000000000 --- a/tests/unit/src/unit/issues/Issue5399.hx +++ /dev/null @@ -1,19 +0,0 @@ -package unit.issues; - -class Issue5399 extends Test { -#if cs - public function test() { - var s:Something = null; - s.width = 10; - eq(s.width, 10); - } -#end -} - -#if cs -@:keep @:struct private class Something { - public var width:Float; - public function new() { - } -} -#end diff --git a/tests/unit/src/unit/issues/Issue5505.hx b/tests/unit/src/unit/issues/Issue5505.hx index bcab45239fa..9e8742888ce 100644 --- a/tests/unit/src/unit/issues/Issue5505.hx +++ b/tests/unit/src/unit/issues/Issue5505.hx @@ -1,7 +1,7 @@ package unit.issues; class Issue5505 extends Test { - #if (java || cs) + #if jvm function test() { eq(StringTools.urlEncode('~'), '~'); eq(StringTools.urlDecode(StringTools.urlEncode('~')), '~'); diff --git a/tests/unit/src/unit/issues/Issue5507.hx b/tests/unit/src/unit/issues/Issue5507.hx index 7f99908cb4a..2daabcbddca 100644 --- a/tests/unit/src/unit/issues/Issue5507.hx +++ b/tests/unit/src/unit/issues/Issue5507.hx @@ -5,7 +5,7 @@ private abstract S(String) to String { } class Issue5507 extends unit.Test { - #if (cs || java) + #if jvm @:readOnly static var a(default,never):S = "hello"; function test() { diff --git a/tests/unit/src/unit/issues/Issue5747.hx b/tests/unit/src/unit/issues/Issue5747.hx deleted file mode 100644 index 65fda8d4ecf..00000000000 --- a/tests/unit/src/unit/issues/Issue5747.hx +++ /dev/null @@ -1,10 +0,0 @@ -package unit.issues; - -class Issue5747 extends Test { - #if (cs && !erase_generics) - function test() { - var a = [1,2,3]; - eq(@:privateAccess a.__a[0], 1); - } - #end -} diff --git a/tests/unit/src/unit/issues/Issue5751.hx b/tests/unit/src/unit/issues/Issue5751.hx deleted file mode 100644 index da7a5bacd83..00000000000 --- a/tests/unit/src/unit/issues/Issue5751.hx +++ /dev/null @@ -1,12 +0,0 @@ -package unit.issues; - -class Issue5751 extends Test { -#if cs - public function test() { - var arr = @:privateAccess (new Array(new cs.NativeArray(10)) : Array>); - eq(arr[0], null); - arr[0] = 100; - eq(arr[0], 100); - } -#end -} diff --git a/tests/unit/src/unit/issues/Issue5862.hx b/tests/unit/src/unit/issues/Issue5862.hx index 5638da7465f..d8b5df7f415 100644 --- a/tests/unit/src/unit/issues/Issue5862.hx +++ b/tests/unit/src/unit/issues/Issue5862.hx @@ -1,14 +1,12 @@ package unit.issues; import haxe.ds.*; -#if java +#if jvm import java.NativeArray; -#elseif cs -import cs.NativeArray; #end class Issue5862 extends Test { - #if (java || cs) + #if jvm public function test() { var imap = new IntMap(); imap.set(0, "val1"); @@ -16,26 +14,12 @@ class Issue5862 extends Test { imap.set(2, "val3"); imap.set(2, "changed_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"); - #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"); @@ -46,7 +30,7 @@ class Issue5862 extends Test { 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"); @@ -57,7 +41,6 @@ class Issue5862 extends Test { for (i in 0...v.length) { t(v[i] == null || v[i].value != "val3"); } - #end var imap = new IntMap(); imap.set(0, "val1"); @@ -66,13 +49,6 @@ class Issue5862 extends Test { imap.set(2, "changed_val3"); imap.set(1, "changed_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"); @@ -80,13 +56,6 @@ class Issue5862 extends Test { 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 - var omap = new ObjectMap<{}, String>(); omap.set(imap, "val1"); omap.set(smap, "val2"); @@ -98,7 +67,7 @@ class Issue5862 extends Test { 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"); @@ -110,7 +79,6 @@ class Issue5862 extends Test { for (i in 0...v.length) { t(v[i] == null || v[i].value != "val2"); } - #end } #end } diff --git a/tests/unit/src/unit/issues/Issue6039.hx b/tests/unit/src/unit/issues/Issue6039.hx deleted file mode 100644 index cc9c02cb87a..00000000000 --- a/tests/unit/src/unit/issues/Issue6039.hx +++ /dev/null @@ -1,31 +0,0 @@ -package unit.issues; -#if cs -import cs.system.Action_1; -#end - -class Issue6039 extends Test -{ - #if cs - public function test() - { - var myStr = null; - var c:Callback = function(str) myStr = str; - c.invokeIt('test'); - this.eq(myStr, 'test'); - } - #end -} - -#if cs -@:keep -private abstract Callback(cs.system.Action_1) from Action_1 to Action_1{ - function new(f) - this = f; - - public function invokeIt(data:String):Void - this.Invoke(data); - - @:from static function fromHaxeFunc(foo:String->Void):Callback - return new Callback(new Action_1(foo)); -} -#end \ No newline at end of file diff --git a/tests/unit/src/unit/issues/Issue6145.hx b/tests/unit/src/unit/issues/Issue6145.hx index ca3c7e7bb0b..78b98d2ee68 100644 --- a/tests/unit/src/unit/issues/Issue6145.hx +++ b/tests/unit/src/unit/issues/Issue6145.hx @@ -1,11 +1,11 @@ package unit.issues; class Issue6145 extends unit.Test { - #if (!cs && !php) + #if (!php) function test() { var r = ~/(a)/; r.match("a"); exc(() -> r.matched(2)); } #end -} \ No newline at end of file +} diff --git a/tests/unit/src/unit/issues/Issue6276.hx b/tests/unit/src/unit/issues/Issue6276.hx index b0a5d975512..4ff6a6227ed 100644 --- a/tests/unit/src/unit/issues/Issue6276.hx +++ b/tests/unit/src/unit/issues/Issue6276.hx @@ -3,7 +3,6 @@ package unit.issues; using Reflect; class Issue6276 extends unit.Test { - #if (!java && !cs) function test(){ var s = "bar"; @@ -40,5 +39,4 @@ class Issue6276 extends unit.Test { var toString = s.field("toString"); eq(s.toString(), Reflect.callMethod(s, toString, [])); } - #end } diff --git a/tests/unit/src/unit/issues/Issue6291.hx b/tests/unit/src/unit/issues/Issue6291.hx index dc748a2bc2d..35fffb2efe7 100644 --- a/tests/unit/src/unit/issues/Issue6291.hx +++ b/tests/unit/src/unit/issues/Issue6291.hx @@ -9,7 +9,7 @@ class Issue6291 extends Test } } -#if (cs || java) +#if jvm @:nativeGen @:keep #end private class BadCode { @@ -32,4 +32,4 @@ private abstract Dictionary(Map) this = new Map(); this.set('a', 1); } -} \ No newline at end of file +} diff --git a/tests/unit/src/unit/issues/Issue6379.hx b/tests/unit/src/unit/issues/Issue6379.hx index 717686f3ffc..ab172878ef4 100644 --- a/tests/unit/src/unit/issues/Issue6379.hx +++ b/tests/unit/src/unit/issues/Issue6379.hx @@ -1,7 +1,8 @@ package unit.issues; class Issue6379 extends unit.Test { - #if (!java && !lua) + // See https://github.com/HaxeFoundation/haxe/issues/8799 for jvm + #if (!jvm && !lua) function test() { eq(g("x_x").length, 2); } @@ -12,4 +13,4 @@ class Issue6379 extends unit.Test { return r; } #end -} \ No newline at end of file +} diff --git a/tests/unit/src/unit/issues/Issue6482.hx b/tests/unit/src/unit/issues/Issue6482.hx index eba5b4f34f4..ca2716ecdb1 100644 --- a/tests/unit/src/unit/issues/Issue6482.hx +++ b/tests/unit/src/unit/issues/Issue6482.hx @@ -1,7 +1,7 @@ package unit.issues; class Issue6482 extends unit.Test { - #if (!cpp && !cs && !java && !lua) + #if (!cpp && !jvm && !lua) function test() { exc(function() { cast("foo", Int); @@ -9,4 +9,4 @@ class Issue6482 extends unit.Test { }); } #end -} \ No newline at end of file +} diff --git a/tests/unit/src/unit/issues/Issue6784.hx b/tests/unit/src/unit/issues/Issue6784.hx deleted file mode 100644 index 84326f64e47..00000000000 --- a/tests/unit/src/unit/issues/Issue6784.hx +++ /dev/null @@ -1,10 +0,0 @@ -package unit.issues; - -class Issue6784 extends Test { - function test() { - #if cs - cs.system.Console.BufferHeight; - #end - noAssert(); - } -} diff --git a/tests/unit/src/unit/issues/Issue6871.hx b/tests/unit/src/unit/issues/Issue6871.hx index caa17047d98..e6b8f02311f 100644 --- a/tests/unit/src/unit/issues/Issue6871.hx +++ b/tests/unit/src/unit/issues/Issue6871.hx @@ -10,7 +10,7 @@ class Issue6871 extends unit.Test { function test() { inline function exception(e:Dynamic) { - return #if cs e.InnerException.Message #else e #end; + return e; } try { @@ -27,4 +27,4 @@ class Issue6871 extends unit.Test { eq(SETTER_ERROR, e); } } -} \ No newline at end of file +} diff --git a/tests/unit/src/unit/issues/Issue6942.hx b/tests/unit/src/unit/issues/Issue6942.hx index eb3c59b56f7..c3765b62524 100644 --- a/tests/unit/src/unit/issues/Issue6942.hx +++ b/tests/unit/src/unit/issues/Issue6942.hx @@ -9,7 +9,7 @@ class Issue6942 extends unit.Test { eq(2, 1 - IntEnum); //these targets have actual UInt type at runtime - #if (flash || cs) + #if flash eq(-4294967295, -UIntEnum); eq(2, 1 - UIntEnum); #else @@ -39,4 +39,4 @@ enum abstract IntTest(Int) from Int to Int { enum abstract UIntTest(UInt) from UInt to UInt { var UIntEnum = -1; -} \ No newline at end of file +} diff --git a/tests/unit/src/unit/issues/Issue7599.hx b/tests/unit/src/unit/issues/Issue7599.hx index a5f03eaf976..c08be1dd639 100644 --- a/tests/unit/src/unit/issues/Issue7599.hx +++ b/tests/unit/src/unit/issues/Issue7599.hx @@ -1,6 +1,6 @@ package unit.issues; -#if (java || cs) +#if jvm @:keep private class Overloader { @@ -48,7 +48,7 @@ private class Overloader { #end class Issue7599 extends unit.Test { - #if (java || cs) + #if jvm function testGeneric() { var overloader = new Overloader(); @@ -61,4 +61,4 @@ class Issue7599 extends unit.Test { } #end -} \ No newline at end of file +} diff --git a/tests/unit/src/unit/issues/Issue7736.hx b/tests/unit/src/unit/issues/Issue7736.hx index 457082beea8..589af2ab98a 100644 --- a/tests/unit/src/unit/issues/Issue7736.hx +++ b/tests/unit/src/unit/issues/Issue7736.hx @@ -1,7 +1,6 @@ package unit.issues; class Issue7736 extends Test { - #if !cs @:nullSafety function test() { var found = null; @@ -17,5 +16,4 @@ class Issue7736 extends Test { eq(5, x); } } - #end } diff --git a/tests/unit/src/unit/issues/Issue8978.hx b/tests/unit/src/unit/issues/Issue8978.hx deleted file mode 100644 index 64b71a96556..00000000000 --- a/tests/unit/src/unit/issues/Issue8978.hx +++ /dev/null @@ -1,25 +0,0 @@ -package unit.issues; - -class Issue8978 extends unit.Test { -#if cs - var classField:cs.types.Int64 = 1; - var anon:{field:cs.types.Int64} = {field:1}; - - function test() { - var local:cs.types.Int64 = 1; - var shift = 1; - - classField <<= shift; - t(2 == classField); - t(1 == classField >> shift); - - anon.field <<= shift; - t(2 == anon.field); - t(1 == anon.field >> shift); - - local <<= shift; - t(2 == local); - t(1 == local >> shift); - } -#end -} \ No newline at end of file diff --git a/tests/unit/src/unit/issues/Issue8979.hx b/tests/unit/src/unit/issues/Issue8979.hx deleted file mode 100644 index 9caa99e9e71..00000000000 --- a/tests/unit/src/unit/issues/Issue8979.hx +++ /dev/null @@ -1,24 +0,0 @@ -package unit.issues; - -import haxe.Json; - -class Issue8979 extends unit.Test { -#if cs - function test() { - var d = new DummyStruct(); - d.hello = 'world'; - var json = Json.stringify(d); - eq('{"hello":"world"}', json); - eq('world', Json.parse(json).hello); - } -#end -} - -#if cs -@:struct -private class DummyStruct { - public var hello:String; - public function new() {} -} -#end - diff --git a/tests/unit/src/unit/issues/Issue9034.hx b/tests/unit/src/unit/issues/Issue9034.hx index f4704d14914..7e833d6c1cd 100644 --- a/tests/unit/src/unit/issues/Issue9034.hx +++ b/tests/unit/src/unit/issues/Issue9034.hx @@ -3,7 +3,7 @@ package unit.issues; import unit.Test; class Issue9034 extends Test{ - #if java + #if jvm function test() { bar(java.nio.file.Paths.get('build.hxml')); utest.Assert.pass(); @@ -11,4 +11,4 @@ class Issue9034 extends Test{ static public inline function bar(path:java.nio.file.Path):Void { } #end -} \ No newline at end of file +} diff --git a/tests/unit/src/unit/issues/Issue9217.hx b/tests/unit/src/unit/issues/Issue9217.hx index 06fbacbaec3..df62cd61045 100644 --- a/tests/unit/src/unit/issues/Issue9217.hx +++ b/tests/unit/src/unit/issues/Issue9217.hx @@ -3,7 +3,6 @@ package unit.issues; import unit.Test; class Issue9217 extends Test { - #if (!java || jvm) // doesn't work on genjava function test() { eq("default", switch(Ea) { case "FB": "FB"; @@ -39,5 +38,4 @@ class Issue9217 extends Test { var Ea = "Ea"; var FB = "FB"; - #end -} \ No newline at end of file +} diff --git a/tests/unit/src/unit/issues/Issue9220.hx b/tests/unit/src/unit/issues/Issue9220.hx index bfaf5bd15ab..c67c47f6a07 100644 --- a/tests/unit/src/unit/issues/Issue9220.hx +++ b/tests/unit/src/unit/issues/Issue9220.hx @@ -3,9 +3,9 @@ package unit.issues; import unit.Test; class Issue9220 extends Test { - #if java + #if jvm public function test() { eq("12.200", java.NativeString.format(java.util.Locale.US, '%.3f', 12.2)); } #end -} \ No newline at end of file +} diff --git a/tests/unit/src/unit/issues/Issue9438.hx b/tests/unit/src/unit/issues/Issue9438.hx index 239ac1b831e..63a2705627c 100644 --- a/tests/unit/src/unit/issues/Issue9438.hx +++ b/tests/unit/src/unit/issues/Issue9438.hx @@ -1,10 +1,10 @@ package unit.issues; class Issue9438 extends unit.Test { - #if java + #if jvm function test() { var x:java.util.Set = null; utest.Assert.pass(); } #end -} \ No newline at end of file +} diff --git a/tests/unit/src/unit/issues/Issue9601.hx b/tests/unit/src/unit/issues/Issue9601.hx index 495b8b78e6e..fd165f27cbc 100644 --- a/tests/unit/src/unit/issues/Issue9601.hx +++ b/tests/unit/src/unit/issues/Issue9601.hx @@ -1,7 +1,7 @@ package unit.issues; class Issue9601 extends Test { - #if (java || eval) + #if (jvm || eval) public function test() { utest.Assert.same(["", "Test"], ~/^/g.split("Test")); utest.Assert.same(["Test", ""], ~/$/g.split("Test")); diff --git a/tests/unit/src/unit/issues/Issue9619.hx b/tests/unit/src/unit/issues/Issue9619.hx index 6e1596cfe29..36993b74a3b 100644 --- a/tests/unit/src/unit/issues/Issue9619.hx +++ b/tests/unit/src/unit/issues/Issue9619.hx @@ -1,6 +1,6 @@ package unit.issues; -#if (java || cs) +#if jvm private abstract class AbstractOverloadParent { public function new():Void {} @@ -79,7 +79,7 @@ private class ConcreteChild extends AbstractParent { class Issue9619 extends unit.Test { function test() { - #if (java || cs) + #if jvm var cc = new ConcreteOverloadChild(); t(HelperMacros.typeError(new AbstractOverloadParent())); @@ -98,4 +98,4 @@ class Issue9619 extends unit.Test { var atiino:AbstractThatImplementsInterfaceNO = new ConcreteChildThatImplementsNO(); t(atiino.toBeImplemented()); } -} \ No newline at end of file +} diff --git a/tests/unit/src/unit/issues/Issue9738.hx b/tests/unit/src/unit/issues/Issue9738.hx deleted file mode 100644 index afcc9e955c7..00000000000 --- a/tests/unit/src/unit/issues/Issue9738.hx +++ /dev/null @@ -1,18 +0,0 @@ -package unit.issues; - -class Issue9738 extends Test { -#if cs - function test() { - try { - try { - throw new haxe.Exception("Hello"); - } catch (e) { - cs.Lib.rethrow(e); - } - assert(); - } catch(e) { - noAssert(); - } - } -#end -} \ No newline at end of file diff --git a/tests/unit/src/unit/issues/Issue9744.hx b/tests/unit/src/unit/issues/Issue9744.hx index 962bb9a7de1..024d1aea0d9 100644 --- a/tests/unit/src/unit/issues/Issue9744.hx +++ b/tests/unit/src/unit/issues/Issue9744.hx @@ -74,14 +74,11 @@ class NadakoB { } class Issue9744 extends unit.Test { - #if (cs && fast_cast && erase_generics) - #else function testAbstractOverAbstractSelf() { var ref = new Ref(); eq(1, ref.value = 1); eq(1, ref.value); } - #end function testUnopProperties() { var vcs = new Vcs(true); diff --git a/tests/unit/src/unit/issues/Issue9746.hx b/tests/unit/src/unit/issues/Issue9746.hx index e739b38299d..6f10ef46602 100644 --- a/tests/unit/src/unit/issues/Issue9746.hx +++ b/tests/unit/src/unit/issues/Issue9746.hx @@ -138,12 +138,9 @@ private abstract ValueAbstract(Int) { class Issue9746 extends unit.Test { function testClass() { - #if (cs && fast_cast && erase_generics) - #else var ctx = new PropertyClassTestContext(); eq(2, ctx.get()[ctx.index++].propGet += 2); ctx.check(1, 1, 0); - #end var ctx = new PropertyClassTestContext(); eq(2, ctx.get()[ctx.index++].propSet += 2); @@ -154,8 +151,6 @@ class Issue9746 extends unit.Test { ctx.check(1, 1, 1); } - #if (cs && fast_cast && erase_generics) - #else function testClassPrefix() { var ctx = new PropertyClassTestContext(); eq(1, ++ctx.get()[ctx.index++].propGet); @@ -169,7 +164,6 @@ class Issue9746 extends unit.Test { eq(1, ++ctx.get()[ctx.index++].propGetSet); ctx.check(1, 1, 1); } - #end function testClassPostfix() { var ctx = new PropertyClassTestContext(); @@ -213,10 +207,7 @@ class Issue9746 extends unit.Test { eq(2, getA()[index++].prop += 2); eq(1, index); eq(0 /* value semantics */, a.prop); - #if (cs && fast_cast && erase_generics) - #else eq(2, a.prop += 2); eq(2, a.prop); - #end } -} \ No newline at end of file +} diff --git a/tests/unit/src/unit/issues/Issue9791.hx b/tests/unit/src/unit/issues/Issue9791.hx index 901ac140206..b980b78bef6 100644 --- a/tests/unit/src/unit/issues/Issue9791.hx +++ b/tests/unit/src/unit/issues/Issue9791.hx @@ -1,6 +1,6 @@ package unit.issues; -#if java +#if jvm overload function moduleOverload(i:Int) { return "Int: " + i; @@ -13,10 +13,10 @@ overload function moduleOverload(s:String) { #end class Issue9791 extends unit.Test { - #if java + #if jvm function test() { eq("Int: 12", moduleOverload(12)); eq("String: foo", moduleOverload("foo")); } #end -} \ No newline at end of file +} diff --git a/tests/unit/src/unit/issues/Issue9854.hx b/tests/unit/src/unit/issues/Issue9854.hx index 15d50816e19..be614a69be0 100644 --- a/tests/unit/src/unit/issues/Issue9854.hx +++ b/tests/unit/src/unit/issues/Issue9854.hx @@ -1,8 +1,7 @@ package unit.issues; class Issue9854 extends Test { -#if (cs || java) - +#if jvm overload static function infer(s:String):T { return null; diff --git a/tests/unit/src/unit/issues/Issue9946.hx b/tests/unit/src/unit/issues/Issue9946.hx deleted file mode 100644 index 6e501766ce1..00000000000 --- a/tests/unit/src/unit/issues/Issue9946.hx +++ /dev/null @@ -1,30 +0,0 @@ -package unit.issues; - -#if cs -import cs.system.Attribute; -import haxe.test.AttrWithNullType; -import haxe.test.AttrWithNonNullType; -import haxe.test.MyAttrAttribute; -#end - -class Issue9946 extends unit.Test { - #if cs - function test() { - eq(hasNullArg(cs.Lib.toNativeType(AttrWithNullType)), true); - eq(hasNullArg(cs.Lib.toNativeType(AttrWithNonNullType)), false); - } - - static function hasNullArg(cls:cs.system.Type):Null { - var attributes = @:privateAccess new Array(Attribute.GetCustomAttributes(cls)); - - for (attr in attributes) { - if (Std.isOfType(attr, MyAttrAttribute)) { - var a:MyAttrAttribute = cast attr; - return a.check; - } - } - - return null; - } - #end -} diff --git a/tests/unit/src/unitstd/Map.unit.hx b/tests/unit/src/unitstd/Map.unit.hx index a9b4365821b..69633d06519 100644 --- a/tests/unit/src/unitstd/Map.unit.hx +++ b/tests/unit/src/unitstd/Map.unit.hx @@ -256,25 +256,21 @@ map["bar"] = map["foo"] = 9; map["bar"] == 9; map["foo"] == 9; -#if !(java || cs) ['' => ''].keys().next() == ''; ['' => ''].iterator().next() == ''; [2 => 3].keys().next() == 2; [2 => 3].iterator().next() == 3; //[a => b].keys().next() == a; //[a => b].iterator().next() == b; -#end var map:Map; HelperMacros.typedAs((null : Map), map = []); HelperMacros.typeError(map[1] = 1) == true; -#if !(java || cs) ['' => ''].keyValueIterator().next().key == ''; ['' => ''].keyValueIterator().next().value == ''; [2 => 3].keyValueIterator().next().key == 2; [2 => 3].keyValueIterator().next().value == 3; -#end // Test unification diff --git a/tests/unit/src/unitstd/StringTools.unit.hx b/tests/unit/src/unitstd/StringTools.unit.hx index 87e7d7d660d..2cda09e52fe 100644 --- a/tests/unit/src/unitstd/StringTools.unit.hx +++ b/tests/unit/src/unitstd/StringTools.unit.hx @@ -142,7 +142,7 @@ StringTools.isEof(StringTools.fastCodeAt("", 0)) == true; // isEOF #if (neko || lua || eval) StringTools.isEof(null) == true; -#elseif (cs || java || python) +#elseif (java || python) StringTools.isEof( -1) == true; #elseif js // how do I test this here? @@ -165,4 +165,4 @@ aeq(expectedCodes, [for(c in StringTools.iterator(s)) c]); // keyValueIterator() var keyCodes = [for(i => c in StringTools.keyValueIterator(s)) [i, c]]; aeq(expectedKeys, keyCodes.map(a -> a[0])); -aeq(expectedCodes, keyCodes.map(a -> a[1])); \ No newline at end of file +aeq(expectedCodes, keyCodes.map(a -> a[1])); diff --git a/tests/unit/src/unitstd/Type.unit.hx b/tests/unit/src/unitstd/Type.unit.hx index e8b515bbec2..176a16c9978 100644 --- a/tests/unit/src/unitstd/Type.unit.hx +++ b/tests/unit/src/unitstd/Type.unit.hx @@ -3,9 +3,7 @@ Type.getClass("foo") == String; Type.getClass(new C()) == C; //Issue #1485 -#if !(java || cs) Type.getClass([]) == Array; -#end Type.getClass(Float) == null; Type.getClass(null) == null; Type.getClass(Int) == null; diff --git a/tests/unit/src/unitstd/haxe/Http.unit.hx.disabled b/tests/unit/src/unitstd/haxe/Http.unit.hx.disabled index 524eba37449..be01d900318 100644 --- a/tests/unit/src/unitstd/haxe/Http.unit.hx.disabled +++ b/tests/unit/src/unitstd/haxe/Http.unit.hx.disabled @@ -1,4 +1,3 @@ -#if !cs var http1 = new haxe.Http("_"); var r = ""; http1.onStatus = function(_) r = "status"; @@ -16,4 +15,3 @@ r == "error"; #if !flash exc(function() haxe.Http.requestUrl("_")); #end -#end \ No newline at end of file diff --git a/tests/unit/src/unitstd/haxe/ds/Vector.unit.hx b/tests/unit/src/unitstd/haxe/ds/Vector.unit.hx index 2fd797508ab..33aeff3f9d2 100644 --- a/tests/unit/src/unitstd/haxe/ds/Vector.unit.hx +++ b/tests/unit/src/unitstd/haxe/ds/Vector.unit.hx @@ -27,7 +27,7 @@ vec.get(2) == vNullBool; // fromArray var arr = ["1", "2", "3"]; var vec:haxe.ds.Vector = haxe.ds.Vector.fromArrayCopy(arr); -#if (!flash && !neko && !cs && !java && !lua && !eval && !php) +#if (!flash && !neko && !jvm && !lua && !eval && !php) arr != vec.toData(); #end vec.length == 3; @@ -192,7 +192,7 @@ vec2[1] == "value: 13"; // sort -#if !(neko || cs || java || eval) +#if !(neko || jvm || eval) var vec = new haxe.ds.Vector(4); vec[0] = 99; vec[1] = 101; diff --git a/tests/unit/src/unitstd/haxe/ds/WeakMap.unit.hx b/tests/unit/src/unitstd/haxe/ds/WeakMap.unit.hx index a99c482e6e3..e35e650c8c6 100644 --- a/tests/unit/src/unitstd/haxe/ds/WeakMap.unit.hx +++ b/tests/unit/src/unitstd/haxe/ds/WeakMap.unit.hx @@ -1,4 +1,4 @@ -#if (flash || java) +#if (flash || jvm) var k1 = new IntWrap(1); var k2 = new IntWrap(2); var k3 = new IntWrap(3); @@ -97,4 +97,4 @@ a == []; #else 1 == 1; -#end \ No newline at end of file +#end diff --git a/tests/unit/src/unitstd/haxe/zip/Compress.unit.hx b/tests/unit/src/unitstd/haxe/zip/Compress.unit.hx index 3a96914df67..93c591c8caf 100644 --- a/tests/unit/src/unitstd/haxe/zip/Compress.unit.hx +++ b/tests/unit/src/unitstd/haxe/zip/Compress.unit.hx @@ -1,5 +1,5 @@ -// not supported in js/python/cs yet -#if (cpp || php || java || neko || flash || hl) +// not supported in js/python yet +#if (cpp || php || jvm || neko || flash || hl) var b = haxe.io.Bytes.ofString("test"); var c = haxe.zip.Compress.run(b, 9); diff --git a/tests/unit/src/unitstd/haxe/zip/Uncompress.unit.hx b/tests/unit/src/unitstd/haxe/zip/Uncompress.unit.hx index c42136721c3..eef989338a4 100644 --- a/tests/unit/src/unitstd/haxe/zip/Uncompress.unit.hx +++ b/tests/unit/src/unitstd/haxe/zip/Uncompress.unit.hx @@ -1,5 +1,5 @@ -// not supported in js/python/cs yet -#if (cpp || php || java || neko || flash) +// not supported in js/python yet +#if (cpp || php || jvm || neko || flash) var d = [120, 218, 43, 73, 45, 46, 1, 0, 4, 93, 1, 193]; var b = haxe.io.Bytes.alloc(d.length); for (i in 0...d.length) b.set(i, d[i]); @@ -29,4 +29,4 @@ r.write == 4; c.toString() == "test"; #else 1 == 1; -#end \ No newline at end of file +#end diff --git a/tests/unit/src/unitstd/sys/net/Socket.unit.hx b/tests/unit/src/unitstd/sys/net/Socket.unit.hx index 0a6191f1839..d2ec30468c3 100644 --- a/tests/unit/src/unitstd/sys/net/Socket.unit.hx +++ b/tests/unit/src/unitstd/sys/net/Socket.unit.hx @@ -14,7 +14,7 @@ c.connect(host, port); c.input != null; c.output != null; -#if !java +#if !jvm // select when accept() would succeed var select = sys.net.Socket.select([s], [s], [s], 0.01); select.read.length == 1; @@ -61,4 +61,4 @@ s.close(); #else 1 == 1; -#end \ No newline at end of file +#end From b97d9d48df14190c9eee9e7cd589b97b025bfd52 Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Tue, 6 Feb 2024 19:29:48 +0100 Subject: [PATCH 48/51] separate import/using from type decls --- src/typing/typeloadModule.ml | 85 +++++++++++++++++++----------------- 1 file changed, 44 insertions(+), 41 deletions(-) diff --git a/src/typing/typeloadModule.ml b/src/typing/typeloadModule.ml index 3e4e8df6587..2e3e07f8191 100644 --- a/src/typing/typeloadModule.ml +++ b/src/typing/typeloadModule.ml @@ -62,16 +62,16 @@ module ModuleLevel = struct *) let create_module_types ctx_m m tdecls loadp = let com = ctx_m.com in + let imports_and_usings = DynArray.create () in let module_types = DynArray.create () in let declarations = DynArray.create () in - let add_declaration decl tdecl = - DynArray.add declarations (decl,tdecl); - match tdecl with - | None -> - () - | Some mt -> - ctx_m.com.module_lut#add_module_type m mt; - DynArray.add module_types mt; + let add_declaration decl mt = + DynArray.add declarations (decl,mt); + ctx_m.com.module_lut#add_module_type m mt; + DynArray.add module_types mt; + in + let add_import_declaration i = + DynArray.add imports_and_usings i in let statics = ref [] in let check_name name meta also_statics p = @@ -128,13 +128,13 @@ module ModuleLevel = struct match fst decl with | EImport _ | EUsing _ -> if !has_declaration then raise_typing_error "import and using may not appear after a declaration" p; - add_declaration decl None + add_import_declaration decl | EStatic d -> check_name (fst d.d_name) d.d_meta false (snd d.d_name); has_declaration := true; statics := (d,p) :: !statics; | EClass d -> - add_declaration decl (Some (TClassDecl (handle_class_decl d p))) + add_declaration decl (TClassDecl (handle_class_decl d p)) | EEnum d -> let name = fst d.d_name in has_declaration := true; @@ -149,7 +149,7 @@ module ModuleLevel = struct e_extern = List.mem EExtern d.d_flags; } in if not e.e_extern then check_type_name name d.d_meta p; - add_declaration decl (Some (TEnumDecl e)) + add_declaration decl (TEnumDecl e) | ETypedef d -> let name = fst d.d_name in check_type_name name d.d_meta p; @@ -167,7 +167,7 @@ module ModuleLevel = struct | TMono r -> (match r.tm_type with None -> Monomorph.bind r com.basic.tvoid | _ -> ()) | _ -> () ); - add_declaration decl (Some (TTypeDecl t)) + add_declaration decl (TTypeDecl t) | EAbstract d -> let name = fst d.d_name in check_type_name name d.d_meta p; @@ -206,7 +206,7 @@ module ModuleLevel = struct let options = Warning.from_meta d.d_meta in module_warning com ctx_m.m.curmod WDeprecatedEnumAbstract options "`@:enum abstract` is deprecated in favor of `enum abstract`" p end; - add_declaration decl (Some (TAbstractDecl a)); + add_declaration decl (TAbstractDecl a); begin match d.d_data with | [] when Meta.has Meta.CoreType a.a_meta -> a.a_this <- t_dynamic; @@ -229,7 +229,7 @@ module ModuleLevel = struct a.a_impl <- Some c; c.cl_kind <- KAbstractImpl a; add_class_flag c CFinal; - add_declaration (EClass c_decl,p) (Some (TClassDecl c)); + add_declaration (EClass c_decl,p) (TClassDecl c); end; in List.iter make_decl tdecls; @@ -256,13 +256,13 @@ module ModuleLevel = struct m.m_statics <- Some c; c.cl_kind <- KModuleFields m; add_class_flag c CFinal; - add_declaration (EClass c_def,p) (Some (TClassDecl c)); + add_declaration (EClass c_def,p) (TClassDecl c); end; (* 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. *) m.m_types <- m.m_types @ (DynArray.to_list module_types); - DynArray.to_list declarations + DynArray.to_list imports_and_usings,DynArray.to_list declarations 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 @@ -315,7 +315,7 @@ module ModuleLevel = struct Constraints are handled lazily (no other type is loaded) because they might be recursive anyway *) List.iter (fun d -> match d with - | (EClass d, p),Some (TClassDecl c) -> + | ((EClass d, p),TClassDecl c) -> 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.GenericBuild c.cl_meta then begin @@ -323,14 +323,12 @@ module ModuleLevel = struct c.cl_kind <- KGenericBuild d.d_data; end; if c.cl_path = (["haxe";"macro"],"MacroType") then c.cl_kind <- KMacroType; - | ((EEnum d, p),Some (TEnumDecl e)) -> + | ((EEnum d, p),TEnumDecl e) -> e.e_params <- type_type_params ctx_m TPHType e.e_path p d.d_params; - | ((ETypedef d, p),Some (TTypeDecl t)) -> + | ((ETypedef d, p),TTypeDecl t) -> t.t_params <- type_type_params ctx_m TPHType t.t_path p d.d_params; - | ((EAbstract d, p),Some (TAbstractDecl a)) -> + | ((EAbstract d, p),TAbstractDecl a) -> a.a_params <- type_type_params ctx_m TPHType a.a_path p d.d_params; - | (((EImport _ | EUsing _),_),None) -> - () | _ -> die "" __LOC__ ) decls @@ -393,10 +391,10 @@ module TypeLevel = struct end ) d.d_meta; let prev_build_count = ref (ctx_m.g.build_count - 1) 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 build() = c.cl_build <- (fun()-> Building [c]); - 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]); @@ -642,10 +640,27 @@ module TypeLevel = struct an expression into the context *) let init_module_type ctx_m ((decl,p),tdecl) = + match decl with + | EClass d -> + let c = (match tdecl with TClassDecl c -> c | _ -> die "" __LOC__) in + init_class ctx_m c d p + | EEnum d -> + let e = (match tdecl with TEnumDecl e -> e | _ -> die "" __LOC__) in + init_enum ctx_m e d p + | ETypedef d -> + let t = (match tdecl with TTypeDecl t -> t | _ -> die "" __LOC__) in + init_typedef ctx_m t d p + | EAbstract d -> + let a = (match tdecl with TAbstractDecl a -> a | _ -> die "" __LOC__) in + init_abstract ctx_m a d p + | _ -> + die "" __LOC__ + + let init_imports_or_using ctx_m (decl,p) = let com = ctx_m.com in let check_path_display 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 + in match decl with | EImport (path,mode) -> begin try @@ -658,21 +673,8 @@ module TypeLevel = struct | EUsing path -> check_path_display path p; ImportHandling.init_using ctx_m path p - | EClass d -> - let c = (match tdecl with Some (TClassDecl c) -> c | _ -> die "" __LOC__) in - init_class ctx_m c d p - | EEnum d -> - let e = (match tdecl with Some (TEnumDecl e) -> e | _ -> die "" __LOC__) in - init_enum ctx_m e d p - | ETypedef d -> - let t = (match tdecl with Some (TTypeDecl t) -> t | _ -> die "" __LOC__) in - init_typedef ctx_m t d p - | EAbstract d -> - let a = (match tdecl with Some (TAbstractDecl a) -> a | _ -> die "" __LOC__) in - init_abstract ctx_m a d p - | EStatic _ -> - (* nothing to do here as module fields are collected into a special EClass *) - () + | _ -> + die "" __LOC__ end let make_curmod com g m = @@ -695,7 +697,7 @@ let make_curmod com g m = *) let type_types_into_module com g m tdecls p = let ctx_m = TyperManager.clone_for_module g.root_typer (make_curmod com g m) in - let decls = ModuleLevel.create_module_types ctx_m m tdecls p in + let imports_and_usings,decls = ModuleLevel.create_module_types ctx_m m tdecls p in (* define the per-module context for the next pass *) if ctx_m.g.std_types != null_module then begin add_dependency m ctx_m.g.std_types; @@ -703,6 +705,7 @@ let type_types_into_module com g m tdecls p = ignore(load_instance ctx_m (make_ptp (mk_type_path (["std"],"String")) null_pos) ParamNormal) end; ModuleLevel.init_type_params ctx_m decls; + List.iter (TypeLevel.init_imports_or_using ctx_m) imports_and_usings; (* setup module types *) List.iter (TypeLevel.init_module_type ctx_m) decls; (* Make sure that we actually init the context at some point (issue #9012) *) From 454d3da58d0527846e2471841adfe3f3042592f1 Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Wed, 7 Feb 2024 08:13:48 +0100 Subject: [PATCH 49/51] remove UInt hack in typeloader --- src/typing/typeloadFields.ml | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/src/typing/typeloadFields.ml b/src/typing/typeloadFields.ml index 14edc515192..8502a4dd586 100644 --- a/src/typing/typeloadFields.ml +++ b/src/typing/typeloadFields.ml @@ -605,9 +605,7 @@ let type_var_field ctx t e stat do_display p = 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 - match t with - | TType ({ t_path = ([],"UInt") },[]) | TAbstract ({ a_path = ([],"UInt") },[]) when stat -> { e with etype = t } - | _ -> e + e let type_var_field ctx t e stat do_display p = let save = TypeloadFunction.save_field_state ctx in From 2fb7155a54dacef5e23b98717ab55861988b047c Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Wed, 7 Feb 2024 11:43:00 +0100 Subject: [PATCH 50/51] add load_instance_mode (#11557) --- src/context/display/displayTexpr.ml | 6 +-- src/core/inheritDoc.ml | 10 ++--- src/filters/exceptions.ml | 12 ++--- src/typing/generic.ml | 4 +- src/typing/macroContext.ml | 16 +++---- src/typing/matcher/exprToPattern.ml | 2 +- src/typing/operators.ml | 2 +- src/typing/strictMeta.ml | 2 +- src/typing/typeload.ml | 68 ++++++++++++++++------------- src/typing/typeloadCheck.ml | 2 +- src/typing/typeloadFields.ml | 17 +++----- src/typing/typeloadModule.ml | 15 ++++--- src/typing/typer.ml | 16 +++---- src/typing/typerDisplay.ml | 2 +- 14 files changed, 89 insertions(+), 85 deletions(-) diff --git a/src/context/display/displayTexpr.ml b/src/context/display/displayTexpr.ml index bdd8e72b7a4..fcef424c14d 100644 --- a/src/context/display/displayTexpr.ml +++ b/src/context/display/displayTexpr.ml @@ -90,7 +90,7 @@ let check_display_class ctx decls c = 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) + ignore(Typeload.load_instance ~allow_display:true ctx ptp ParamNormal LoadNormal) | _ -> () ) sc.d_flags; @@ -112,14 +112,14 @@ 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 null_pos st.d_params); - ignore(Typeload.load_complex_type ctx true st.d_data) + ignore(Typeload.load_complex_type ctx true LoadNormal 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 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)) + ignore(Typeload.load_complex_type ctx true LoadNormal (ct,p)) | _ -> () ) sa.d_flags diff --git a/src/core/inheritDoc.ml b/src/core/inheritDoc.ml index 33f2fa1e7b3..25af705d208 100644 --- a/src/core/inheritDoc.ml +++ b/src/core/inheritDoc.ml @@ -34,8 +34,8 @@ let rec get_class_field c field_name = | None -> raise Not_found | Some (csup, _) -> get_class_field csup field_name -let find_type ctx (tp,p) = - try Typeload.load_instance' ctx (make_ptp tp p) ParamSpawnMonos +let find_type ctx mode (tp,p) = + try Typeload.load_instance' ctx (make_ptp tp p) ParamSpawnMonos mode with _ -> raise Not_found (** @@ -160,7 +160,7 @@ and get_target_doc ctx e_target = | _ -> mk_type_path path in - let t = (find_type ctx (tp,snd e_target)) in + let t = (find_type ctx LoadNormal (tp,snd e_target)) in try match follow t with | TInst (c, _) -> @@ -207,11 +207,11 @@ and get_target_doc ctx e_target = in let resolve_type () = let tp = mk_type_path path, snd e_target in - resolve_type_t (find_type ctx tp) + resolve_type_t (find_type ctx LoadNormal tp) in let resolve_sub_type sub = let tp = mk_type_path ~sub path, snd e_target in - resolve_type_t (find_type ctx tp) + resolve_type_t (find_type ctx LoadNormal tp) in try match sub with diff --git a/src/filters/exceptions.ml b/src/filters/exceptions.ml index 045b449ef50..9be6fae7503 100644 --- a/src/filters/exceptions.ml +++ b/src/filters/exceptions.ml @@ -511,23 +511,23 @@ let filter tctx = make_ptp tp null_pos in let wildcard_catch_type = - let t = Typeload.load_instance tctx (tp config.ec_wildcard_catch) ParamSpawnMonos in + let t = Typeload.load_instance tctx (tp config.ec_wildcard_catch) ParamSpawnMonos LoadNormal in if is_dynamic t then t_dynamic else t and base_throw_type = - let t = Typeload.load_instance tctx (tp config.ec_base_throw) ParamSpawnMonos in + let t = Typeload.load_instance tctx (tp config.ec_base_throw) ParamSpawnMonos LoadNormal in if is_dynamic t then t_dynamic else t and haxe_exception_type, haxe_exception_class = - match Typeload.load_instance tctx (tp haxe_exception_type_path) ParamSpawnMonos with + match Typeload.load_instance tctx (tp haxe_exception_type_path) ParamSpawnMonos LoadNormal with | TInst(cls,_) as t -> t,cls | _ -> raise_typing_error "haxe.Exception is expected to be a class" null_pos and value_exception_type, value_exception_class = - match Typeload.load_instance tctx (tp value_exception_type_path) ParamSpawnMonos with + match Typeload.load_instance tctx (tp value_exception_type_path) ParamSpawnMonos LoadNormal with | TInst(cls,_) as t -> t,cls | _ -> raise_typing_error "haxe.ValueException is expected to be a class" null_pos and haxe_native_stack_trace = - match Typeload.load_instance tctx (tp (["haxe"],"NativeStackTrace")) ParamSpawnMonos with + match Typeload.load_instance tctx (tp (["haxe"],"NativeStackTrace")) ParamSpawnMonos LoadNormal with | TInst(cls,_) -> cls | TAbstract({ a_impl = Some cls },_) -> cls | _ -> raise_typing_error "haxe.NativeStackTrace is expected to be a class or an abstract" null_pos @@ -644,7 +644,7 @@ let insert_save_stacks tctx = *) let patch_constructors tctx = let tp = make_ptp (mk_type_path haxe_exception_type_path) null_pos in - match Typeload.load_instance tctx tp ParamSpawnMonos with + match Typeload.load_instance tctx tp ParamSpawnMonos LoadNormal with (* Add only if `__shiftStack` method exists *) | TInst(cls,_) when PMap.mem "__shiftStack" cls.cl_fields -> (fun mt -> diff --git a/src/typing/generic.ml b/src/typing/generic.ml index cadbef00cfc..32dcdbd9f24 100644 --- a/src/typing/generic.ml +++ b/src/typing/generic.ml @@ -171,7 +171,7 @@ let static_method_container gctx c cf p = let pack = fst c.cl_path in let name = (snd c.cl_path) ^ "_" ^ cf.cf_name ^ "_" ^ gctx.name in try - let t = Typeload.load_instance ctx (make_ptp (mk_type_path (pack,name)) p) ParamSpawnMonos in + let t = Typeload.load_instance ctx (make_ptp (mk_type_path (pack,name)) p) ParamSpawnMonos LoadNormal in match t with | TInst(cg,_) -> cg | _ -> raise_typing_error ("Cannot specialize @:generic static method because the generated type name is already used: " ^ name) p @@ -271,7 +271,7 @@ let build_generic_class ctx c p tl = let gctx = make_generic ctx c.cl_params tl (Meta.has (Meta.Custom ":debug.generic") c.cl_meta) p in let name = (snd c.cl_path) ^ "_" ^ gctx.name in try - let t = Typeload.load_instance ctx (make_ptp (mk_type_path (pack,name)) p) ParamNormal in + let t = Typeload.load_instance ctx (make_ptp (mk_type_path (pack,name)) p) ParamNormal LoadNormal in match t with | TInst({ cl_kind = KGenericInstance (csup,_) },_) when c == csup -> t | _ -> raise_typing_error ("Cannot specialize @:generic because the generated type name is already used: " ^ name) p diff --git a/src/typing/macroContext.ml b/src/typing/macroContext.ml index 65b831ad254..fc1c46f036b 100644 --- a/src/typing/macroContext.ml +++ b/src/typing/macroContext.ml @@ -330,14 +330,14 @@ let make_macro_api ctx mctx p = mk_type_path path in try - let m = Some (Typeload.load_instance ctx (make_ptp tp p) ParamSpawnMonos) in + let m = Some (Typeload.load_instance ctx (make_ptp tp p) ParamSpawnMonos LoadAny) in m with Error { err_message = Module_not_found _; err_pos = p2 } when p == p2 -> None ) ); MacroApi.resolve_type = (fun t p -> - typing_timer ctx false (fun ctx -> Typeload.load_complex_type ctx false (t,p)) + typing_timer ctx false (fun ctx -> Typeload.load_complex_type ctx false LoadAny (t,p)) ); MacroApi.resolve_complex_type = (fun t -> typing_timer ctx false (fun ctx -> @@ -450,7 +450,7 @@ let make_macro_api ctx mctx p = MacroApi.define_type = (fun v mdep -> let cttype = mk_type_path ~sub:"TypeDefinition" (["haxe";"macro"],"Expr") in let mctx = (match ctx.g.macros with None -> die "" __LOC__ | Some (_,mctx) -> mctx) in - let ttype = Typeload.load_instance mctx (make_ptp cttype p) ParamNormal in + let ttype = Typeload.load_instance mctx (make_ptp cttype p) ParamNormal LoadNormal in let f () = Interp.decode_type_def v in let m, tdef, pos = safe_decode ctx.com v "TypeDefinition" ttype p f in let has_native_meta = match tdef with @@ -825,7 +825,7 @@ let type_macro ctx mode cpath f (el:Ast.expr list) p = in let mpos = mfield.cf_pos in let ctexpr = mk_type_path (["haxe";"macro"],"Expr") in - let expr = Typeload.load_instance mctx (make_ptp ctexpr p) ParamNormal in + let expr = Typeload.load_instance mctx (make_ptp ctexpr p) ParamNormal LoadNormal in (match mode with | MDisplay -> raise Exit (* We don't have to actually call the macro. *) @@ -834,18 +834,18 @@ let type_macro ctx mode cpath f (el:Ast.expr list) p = | MBuild -> let params = [TPType (make_ptp_th (mk_type_path ~sub:"Field" (["haxe";"macro"],"Expr")) null_pos)] in let ctfields = mk_type_path ~params ([],"Array") in - let tfields = Typeload.load_instance mctx (make_ptp ctfields p) ParamNormal in + let tfields = Typeload.load_instance mctx (make_ptp ctfields p) ParamNormal LoadNormal in unify mctx mret tfields mpos | MMacroType -> let cttype = mk_type_path (["haxe";"macro"],"Type") in - let ttype = Typeload.load_instance mctx (make_ptp cttype p) ParamNormal in + let ttype = Typeload.load_instance mctx (make_ptp cttype p) ParamNormal LoadNormal in try unify_raise mret ttype mpos; (* TODO: enable this again in the future *) (* warning ctx WDeprecated "Returning Type from @:genericBuild macros is deprecated, consider returning ComplexType instead" p; *) with Error { err_message = Unify _ } -> let cttype = mk_type_path ~sub:"ComplexType" (["haxe";"macro"],"Expr") in - let ttype = Typeload.load_instance mctx (make_ptp cttype p) ParamNormal in + let ttype = Typeload.load_instance mctx (make_ptp cttype p) ParamNormal LoadNormal in unify_raise mret ttype mpos; ); (* @@ -971,7 +971,7 @@ let type_macro ctx mode cpath f (el:Ast.expr list) p = spawn_monomorph ctx.e p else try let ct = Interp.decode_ctype v in - Typeload.load_complex_type ctx false ct; + Typeload.load_complex_type ctx false LoadNormal ct; with MacroApi.Invalid_expr | EvalContext.RunTimeException _ -> Interp.decode_type v in diff --git a/src/typing/matcher/exprToPattern.ml b/src/typing/matcher/exprToPattern.ml index 4ca68a1c4a2..34a6ccd9ad1 100644 --- a/src/typing/matcher/exprToPattern.ml +++ b/src/typing/matcher/exprToPattern.ml @@ -58,7 +58,7 @@ let get_general_module_type ctx mt p = end | _ -> raise_typing_error "Cannot use this type as a value" p in - Typeload.load_instance ctx (make_ptp {tname=loop mt;tpackage=[];tsub=None;tparams=[]} p) ParamSpawnMonos + Typeload.load_instance ctx (make_ptp {tname=loop mt;tpackage=[];tsub=None;tparams=[]} p) ParamSpawnMonos LoadNormal let unify_type_pattern ctx mt t p = let tcl = get_general_module_type ctx mt p in diff --git a/src/typing/operators.ml b/src/typing/operators.ml index 8cc4ecd776c..c75663686be 100644 --- a/src/typing/operators.ml +++ b/src/typing/operators.ml @@ -386,7 +386,7 @@ let make_binop ctx op e1 e2 is_assign_op p = unify ctx e2.etype b p; mk_op e1 e2 b | OpInterval -> - let t = Typeload.load_instance ctx (make_ptp (mk_type_path (["std"],"IntIterator")) null_pos) ParamNormal in + let t = Typeload.load_instance ctx (make_ptp (mk_type_path (["std"],"IntIterator")) null_pos) ParamNormal LoadNormal in let e1 = AbstractCast.cast_or_unify_raise ctx tint e1 e1.epos in let e2 = AbstractCast.cast_or_unify_raise ctx tint e2 e2.epos in BinopSpecial (mk (TNew ((match t with TInst (c,[]) -> c | _ -> die "" __LOC__),[],[e1;e2])) t p,false) diff --git a/src/typing/strictMeta.ml b/src/typing/strictMeta.ml index 700573708ca..a06b6bcafde 100644 --- a/src/typing/strictMeta.ml +++ b/src/typing/strictMeta.ml @@ -174,7 +174,7 @@ let get_strict_meta ctx meta params pos = display_error ctx.com "A @:strict metadata must contain exactly one parameter. Please check the documentation for more information" pos; raise Exit in - let t = Typeload.load_complex_type ctx false (ctype,pos) in + let t = Typeload.load_complex_type ctx false LoadNormal (ctype,pos) in flush_pass ctx.g PBuildClass "get_strict_meta"; let texpr = type_expr ctx changed_expr NoValue in let with_type_expr = (ECheckType( (EConst (Ident "null"), pos), (ctype,null_pos) ), pos) in diff --git a/src/typing/typeload.ml b/src/typing/typeload.ml index 3b11996a08b..c59330fc8f5 100644 --- a/src/typing/typeload.ml +++ b/src/typing/typeload.ml @@ -293,6 +293,11 @@ type load_instance_param_mode = | ParamSpawnMonos | ParamCustom of (build_info -> Type.t list option -> Type.t list) +type load_instance_mode = + | LoadNormal + | LoadReturn + | LoadAny (* We don't necessarily know why we're loading, so let's just load anything *) + let rec maybe_build_instance ctx t0 get_params p = let rec loop t = match t with | TInst({cl_kind = KGeneric} as c,tl) -> @@ -332,7 +337,8 @@ let rec load_params ctx info params p = let c = mk_class ctx.m.curmod ([],name) p (pos e) in c.cl_kind <- KExpr e; TInst (c,[]),pos e - | TPType t -> load_complex_type ctx true t,pos t + | TPType t -> + load_complex_type ctx true LoadNormal t,pos t in let checks = DynArray.create () in let rec loop tl1 tl2 is_rest = match tl1,tl2 with @@ -400,7 +406,7 @@ let rec load_params ctx info params p = params (* build an instance from a full type *) -and load_instance' ctx ptp get_params = +and load_instance' ctx ptp get_params mode = let t = ptp.path in try if t.tpackage <> [] || t.tsub <> None then raise Not_found; @@ -412,7 +418,7 @@ and load_instance' ctx ptp get_params = let info = ctx.g.get_build_info ctx mt ptp.pos_full in if info.build_path = ([],"Dynamic") then match t.tparams with | [] -> t_dynamic - | [TPType t] -> TDynamic (Some (load_complex_type ctx true t)) + | [TPType t] -> TDynamic (Some (load_complex_type ctx true LoadNormal t)) | _ -> raise_typing_error "Too many parameters for Dynamic" ptp.pos_full else if info.build_params = [] then begin match t.tparams with | [] -> @@ -440,9 +446,9 @@ and load_instance' ctx ptp get_params = maybe_build_instance ctx t get_params ptp.pos_full end -and load_instance ctx ?(allow_display=false) ptp get_params = +and load_instance ctx ?(allow_display=false) ptp get_params mode = try - let t = load_instance' ctx ptp get_params in + let t = load_instance' ctx ptp get_params mode in if allow_display then DisplayEmitter.check_display_type ctx t ptp; t 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 -> @@ -452,17 +458,17 @@ and load_instance ctx ?(allow_display=false) ptp get_params = (* build an instance from a complex type *) -and load_complex_type' ctx allow_display (t,p) = +and load_complex_type' ctx allow_display mode (t,p) = match t with - | CTParent t -> load_complex_type ctx allow_display t + | CTParent t -> load_complex_type ctx allow_display mode t | CTPath { path = {tpackage = ["$"]; tname = "_hx_mono" }} -> spawn_monomorph ctx.e p - | CTPath ptp -> load_instance ~allow_display ctx ptp ParamNormal + | CTPath ptp -> load_instance ~allow_display ctx ptp ParamNormal mode | CTOptional _ -> raise_typing_error "Optional type not allowed here" p | CTNamed _ -> raise_typing_error "Named type not allowed here" p | CTIntersection tl -> let tl = List.map (fun (t,pn) -> try - (load_complex_type ctx allow_display (t,pn),pn) + (load_complex_type ctx allow_display LoadNormal (t,pn),pn) with DisplayException(DisplayFields ({fkind = CRTypeHint} as r)) -> let l = List.filter (fun item -> match item.ci_kind with | ITType({kind = Struct},_) -> true @@ -479,7 +485,7 @@ and load_complex_type' ctx allow_display (t,p) = ) "constraint" in TLazy r | CTExtend (tl,l) -> - begin match load_complex_type ctx allow_display (CTAnonymous l,p) with + begin match load_complex_type ctx allow_display LoadNormal (CTAnonymous l,p) with | TAnon a as ta -> let mk_extension (t,p) = match follow t with @@ -503,7 +509,7 @@ and load_complex_type' ctx allow_display (t,p) = in let il = List.map (fun ptp -> try - (load_instance ctx ~allow_display ptp ParamNormal,ptp.pos_full) + (load_instance ctx ~allow_display ptp ParamNormal LoadNormal,ptp.pos_full) with DisplayException(DisplayFields ({fkind = CRTypeHint} as r)) -> let l = List.filter (fun item -> match item.ci_kind with | ITType({kind = Struct},_) -> true @@ -533,9 +539,9 @@ and load_complex_type' ctx allow_display (t,p) = let pf = snd f.cff_name in let p = f.cff_pos in if PMap.mem n acc then raise_typing_error ("Duplicate field declaration : " ^ n) pf; - let topt = function + let topt mode = function | None -> raise_typing_error ("Explicit type required for field " ^ n) p - | Some t -> load_complex_type ctx allow_display t + | Some t -> load_complex_type ctx allow_display mode t in if n = "new" then warning ctx WDeprecated "Structures with new are deprecated, use haxe.Constraints.Constructible instead" p; let no_expr = function @@ -563,19 +569,19 @@ and load_complex_type' ctx allow_display (t,p) = | FVar(t,e) when !final -> no_expr e; let t = (match t with None -> raise_typing_error "Type required for structure property" p | Some t -> t) in - load_complex_type ctx allow_display t, Var { v_read = AccNormal; v_write = AccNever } + load_complex_type ctx allow_display LoadNormal t, Var { v_read = AccNormal; v_write = AccNever } | FVar (Some (CTPath({path = {tpackage=[];tname="Void"}}),_), _) | FProp (_,_,Some (CTPath({path = {tpackage=[];tname="Void"}}),_),_) -> raise_typing_error "Fields of type Void are not allowed in structures" p | FVar (t, e) -> no_expr e; - topt t, Var { v_read = AccNormal; v_write = AccNormal } + topt LoadNormal t, Var { v_read = AccNormal; v_write = AccNormal } | FFun fd -> params := (!type_function_params_ref) ctx fd TPHAnonField (fst f.cff_name) p; no_expr fd.f_expr; let old = ctx.type_params in ctx.type_params <- !params @ old; - let args = List.map (fun ((name,_),o,_,t,e) -> no_expr e; name, o, topt t) fd.f_args in - let t = TFun (args,topt fd.f_type), Method (if !dyn then MethDynamic else MethNormal) in + let args = List.map (fun ((name,_),o,_,t,e) -> no_expr e; name, o, topt LoadNormal t) fd.f_args in + let t = TFun (args,topt LoadReturn fd.f_type), Method (if !dyn then MethDynamic else MethNormal) in ctx.type_params <- old; t | FProp (i1,i2,t,e) -> @@ -594,7 +600,7 @@ and load_complex_type' ctx allow_display (t,p) = raise_typing_error "Custom property access is no longer supported in Haxe 3" f.cff_pos; in let t = (match t with None -> raise_typing_error "Type required for structure property" p | Some t -> t) in - load_complex_type ctx allow_display t, Var { v_read = access i1 true; v_write = access i2 false } + load_complex_type ctx allow_display LoadNormal t, Var { v_read = access i1 true; v_write = access i2 false } ) in let t = if Meta.has Meta.Optional f.cff_meta then ctx.t.tnull t else t in let cf = { @@ -623,17 +629,17 @@ and load_complex_type' ctx allow_display (t,p) = | CTFunction (args,r) -> match args with | [CTPath { path = {tpackage = []; tparams = []; tname = "Void" }},_] -> - TFun ([],load_complex_type ctx allow_display r) + TFun ([],load_complex_type ctx allow_display LoadReturn r) | _ -> TFun (List.map (fun t -> let t, opt = (match fst t with CTOptional t | CTParent((CTOptional t,_)) -> t, true | _ -> t,false) in let n,t = (match fst t with CTNamed (n,t) -> (fst n), t | _ -> "", t) in - n,opt,load_complex_type ctx allow_display t - ) args,load_complex_type ctx allow_display r) + n,opt,load_complex_type ctx allow_display LoadNormal t + ) args,load_complex_type ctx allow_display LoadReturn r) -and load_complex_type ctx allow_display (t,pn) = +and load_complex_type ctx allow_display mode (t,pn) = try - load_complex_type' ctx allow_display (t,pn) + load_complex_type' ctx allow_display mode (t,pn) with Error ({ err_message = Module_not_found(([],name)) } as err) -> if Diagnostics.error_in_diagnostics_run ctx.com err.err_pos then begin delay ctx.g PForce (fun () -> DisplayToplevel.handle_unresolved_identifier ctx name err.err_pos true); @@ -669,17 +675,17 @@ and init_meta_overloads ctx co cf = end; let params : type_params = (!type_function_params_ref) ctx f TPHMethod cf.cf_name p in ctx.type_params <- params @ ctx.type_params; - let topt = function None -> raise_typing_error "Explicit type required" p | Some t -> load_complex_type ctx true t in + let topt mode = function None -> raise_typing_error "Explicit type required" p | Some t -> load_complex_type ctx true mode t in let args = List.map (fun ((a,_),opt,_,t,cto) -> - let t = if opt then ctx.t.tnull (topt t) else topt t in + let t = if opt then ctx.t.tnull (topt LoadNormal t) else topt LoadNormal t in let opt = opt || cto <> None in a,opt,t ) f.f_args in - let cf = { cf with cf_type = TFun (args,topt f.f_type); cf_params = params; cf_meta = cf_meta} in + let cf = { cf with cf_type = TFun (args,topt LoadReturn f.f_type); cf_params = params; cf_meta = cf_meta} in generate_args_meta ctx.com co (fun meta -> cf.cf_meta <- meta :: cf.cf_meta) f.f_args; overloads := cf :: !overloads; ctx.type_params <- old; @@ -712,10 +718,10 @@ let t_iterator ctx p = (* load either a type t or Null if not defined *) -let load_type_hint ?(opt=false) ctx pcur t = +let load_type_hint ?(opt=false) ctx pcur mode t = let t = match t with | None -> spawn_monomorph ctx.e pcur - | Some (t,p) -> load_complex_type ctx true (t,p) + | Some (t,p) -> load_complex_type ctx true mode (t,p) in if opt then ctx.t.tnull t else t @@ -747,7 +753,7 @@ and type_type_params ctx host path p tpl = () | Some ct -> let r = make_lazy ctx.g ttp.ttp_type (fun r -> - let t = load_complex_type ctx true ct in + let t = load_complex_type ctx true LoadNormal ct in begin match host with | TPHType -> () @@ -768,9 +774,9 @@ and type_type_params ctx host path p tpl = | Some th -> let constraints = lazy ( let rec loop th = match fst th with - | CTIntersection tl -> List.map (load_complex_type ctx true) tl + | CTIntersection tl -> List.map (load_complex_type ctx true LoadNormal) tl | CTParent ct -> loop ct - | _ -> [load_complex_type ctx true th] + | _ -> [load_complex_type ctx true LoadNormal th] in let constr = loop th in (* check against direct recursion *) diff --git a/src/typing/typeloadCheck.ml b/src/typing/typeloadCheck.ml index c1cac9b1430..65b9e6c956f 100644 --- a/src/typing/typeloadCheck.ml +++ b/src/typing/typeloadCheck.ml @@ -595,7 +595,7 @@ module Inheritance = struct let fl = ExtList.List.filter_map (fun (is_extends,ptp) -> try let t = try - Typeload.load_instance ~allow_display:true ctx ptp ParamNormal + Typeload.load_instance ~allow_display:true ctx ptp ParamNormal LoadNormal with DisplayException(DisplayFields ({fkind = CRTypeHint} as r)) -> (* We don't allow `implements` on interfaces. Just raise fields completion with no fields. *) if not is_extends && (has_class_flag c CInterface) then raise_fields [] CRImplements r.fsubject; diff --git a/src/typing/typeloadFields.ml b/src/typing/typeloadFields.ml index 8502a4dd586..12bbbbb0041 100644 --- a/src/typing/typeloadFields.ml +++ b/src/typing/typeloadFields.ml @@ -280,9 +280,6 @@ let transform_abstract_field com this_t a_t a f = | _ -> f -let lazy_display_type ctx f = - f () - type enum_abstract_mode = | EAString | EAInt of int ref @@ -889,7 +886,7 @@ let load_variable_type_hint ctx fctx eo p = function | None -> mk_mono() | Some t -> - lazy_display_type ctx (fun () -> load_type_hint ctx p (Some t)) + load_type_hint ctx p LoadNormal (Some t) let create_variable (ctx,cctx,fctx) c f t eo p = let is_abstract_enum_field = List.mem_assoc AEnum f.cff_access in @@ -1103,7 +1100,7 @@ let check_abstract (ctx,cctx,fctx) a c cf fd t ret p = end end -let type_opt (ctx,cctx,fctx) p t = +let type_opt (ctx,cctx,fctx) p mode t = let c = cctx.tclass in let is_truly_extern = (has_class_flag c CExtern || fctx.is_extern) @@ -1120,7 +1117,7 @@ let type_opt (ctx,cctx,fctx) p t = display_error ctx.com "Type required for abstract functions" p; t_dynamic | _ -> - Typeload.load_type_hint ctx p t + Typeload.load_type_hint ctx p mode t let setup_args_ret ctx cctx fctx name fd p = let c = cctx.tclass in @@ -1161,7 +1158,7 @@ let setup_args_ret ctx cctx fctx name fd p = ctx.t.tvoid else begin let def () = - type_opt (ctx,cctx,fctx) p fd.f_type + type_opt (ctx,cctx,fctx) p LoadReturn fd.f_type in maybe_use_property_type fd.f_type (fun () -> match Lazy.force mk with MKGetter | MKSetter -> true | _ -> false) def end in @@ -1174,7 +1171,7 @@ let setup_args_ret ctx cctx fctx name fd p = 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 + type_opt (ctx,cctx,fctx) p LoadNormal cto in if i = 0 then maybe_use_property_type cto (fun () -> match Lazy.force mk with MKSetter -> true | _ -> false) def else def() in @@ -1239,7 +1236,7 @@ let create_method (ctx,cctx,fctx) c f fd p = | None -> () | Some (CTPath ({ path = {tpackage = []; tname = "Void" } as tp}),p) -> 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); + ignore(load_instance ~allow_display:true ctx (make_ptp tp p) ParamNormal LoadReturn); (* VOIDTODO *) | _ -> raise_typing_error "A class constructor can't have a return type" p; end | false,_ -> @@ -1354,7 +1351,7 @@ let create_property (ctx,cctx,fctx) c f (get,set,t,eo) p = let ret = (match t, eo with | None, None -> raise_typing_error "Property requires type-hint or initialization" p; | None, _ -> mk_mono() - | Some t, _ -> lazy_display_type ctx (fun () -> load_type_hint ctx p (Some t)) + | Some t, _ -> load_type_hint ctx p LoadNormal (Some t) ) in let t_get,t_set = match cctx.abstract with | Some a when fctx.is_abstract_member -> diff --git a/src/typing/typeloadModule.ml b/src/typing/typeloadModule.ml index 2e3e07f8191..e78a38f0d40 100644 --- a/src/typing/typeloadModule.ml +++ b/src/typing/typeloadModule.ml @@ -342,7 +342,7 @@ module TypeLevel = struct let rt = (match c.ec_type with | None -> et | Some (t,pt) -> - let t = load_complex_type ctx_ef true (t,pt) in + let t = load_complex_type ctx_ef true LoadReturn (t,pt) in (match follow t with | TEnum (te,_) when te == e -> () @@ -351,7 +351,8 @@ module TypeLevel = struct t ) in let t = (match c.ec_args with - | [] -> rt + | [] -> + rt | l -> is_flat := false; let pnames = ref PMap.empty in @@ -359,7 +360,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_ef p (Some (t,tp)) + s, opt, load_type_hint ~opt ctx_ef p LoadNormal (Some (t,tp)) ) l, rt) ) in let f = { @@ -524,7 +525,7 @@ module TypeLevel = struct 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 = load_complex_type ctx_td true LoadNormal d.d_data in let tt = (match fst d.d_data with | CTExtend _ -> tt | CTPath { path = {tpackage = ["haxe";"macro"]; tname = "MacroType" }} -> @@ -581,7 +582,7 @@ module TypeLevel = struct let is_type = ref false in let load_type t from = let _, pos = t in - let t = load_complex_type ctx_a true t in + let t = load_complex_type ctx_a true LoadNormal 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_a.g t (fun r -> @@ -604,7 +605,7 @@ 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_a true t in + let at = load_complex_type ctx_a true LoadNormal t in delay ctx_a.g PForce (fun () -> let rec loop stack t = match follow t with @@ -702,7 +703,7 @@ let type_types_into_module com g m tdecls p = 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_m (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 LoadNormal) end; ModuleLevel.init_type_params ctx_m decls; List.iter (TypeLevel.init_imports_or_using ctx_m) imports_and_usings; diff --git a/src/typing/typer.ml b/src/typing/typer.ml index 2bbfed0995c..ea45639b894 100644 --- a/src/typing/typer.ml +++ b/src/typing/typer.ml @@ -704,7 +704,7 @@ and type_vars ctx vl p = and pv = snd ev.ev_name in 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 t = Typeload.load_type_hint ctx p LoadNormal ev.ev_type in let e = (match ev.ev_expr with | None -> None | Some e -> @@ -1021,7 +1021,7 @@ and type_new ctx ptp el with_type force_inline p = ) in let t = try - Typeload.load_instance ctx ptp (ParamCustom get_params) + Typeload.load_instance ctx ptp (ParamCustom get_params) LoadNormal with exc -> restore(); (* If we fail for some reason, process the arguments in case we want to display them (#7650). *) @@ -1099,7 +1099,7 @@ and type_try ctx e1 catches with_type p = in let catches,el = List.fold_left (fun (acc1,acc2) ((v,pv),t,e_ast,pc) -> let th = Option.default (make_ptp_th { tpackage = ["haxe"]; tname = "Exception"; tsub = None; tparams = [] } null_pos) t in - let t = Typeload.load_complex_type ctx true th in + let t = Typeload.load_complex_type ctx true LoadNormal th in let rec loop t = match follow t with | TInst ({ cl_kind = KTypeParameter _} as c,_) when not (TypeloadCheck.is_generic_parameter ctx c) -> raise_typing_error "Cannot catch non-generic type parameter" p @@ -1233,8 +1233,8 @@ and type_local_function ctx_from kind f with_type p = let old_tp = ctx.type_params in ctx.type_params <- params @ ctx.type_params; 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 rt = Typeload.load_type_hint ctx p LoadReturn f.f_type in + let type_arg _ opt t p = Typeload.load_type_hint ~opt ctx p LoadNormal t in let args = new FunctionArguments.function_arguments ctx.com type_arg false ctx.f.in_display None f.f_args in let targs = args#for_type in let maybe_unify_arg t1 t2 = @@ -1527,7 +1527,7 @@ and type_return ?(implicit=false) ctx e with_type p = and type_cast ctx e t p = let tpos = pos t in - let t = Typeload.load_complex_type ctx true t in + let t = Typeload.load_complex_type ctx true LoadNormal t in let check_param pt = match follow pt with | TMono _ -> () (* This probably means that Dynamic wasn't bound (issue #4675). *) | t when t == t_dynamic -> () @@ -1802,7 +1802,7 @@ and type_expr ?(mode=MGet) ctx (e,p) (with_type:WithType.t) = | EConst (Regexp (r,opt)) -> let str = mk (TConst (TString r)) ctx.t.tstring p in let opt = mk (TConst (TString opt)) ctx.t.tstring p in - let t = Typeload.load_instance ctx (make_ptp (mk_type_path (["std"],"EReg")) null_pos) ParamNormal in + let t = Typeload.load_instance ctx (make_ptp (mk_type_path (["std"],"EReg")) null_pos) ParamNormal LoadNormal in mk (TNew ((match t with TInst (c,[]) -> c | _ -> die "" __LOC__),[],[str;opt])) t p | EConst (String(s,SSingleQuotes)) when s <> "" -> type_expr ctx (format_string ctx s p) with_type @@ -1990,7 +1990,7 @@ and type_expr ?(mode=MGet) ctx (e,p) (with_type:WithType.t) = | EDisplay (e,dk) -> TyperDisplay.handle_edisplay ctx e dk mode with_type | ECheckType (e,t) -> - let t = Typeload.load_complex_type ctx true t in + let t = Typeload.load_complex_type ctx true LoadAny t in let e = type_expr ctx e (WithType.with_type t) in let e = AbstractCast.cast_or_unify ctx t e p in if e.etype == t then e else mk (TCast (e,None)) t p diff --git a/src/typing/typerDisplay.ml b/src/typing/typerDisplay.ml index 7734c359d90..1c38d20f87f 100644 --- a/src/typing/typerDisplay.ml +++ b/src/typing/typerDisplay.ml @@ -310,7 +310,7 @@ let rec handle_signature_display ctx e_ast with_type = in handle_call tl el e1.epos | ENew(ptp,el) -> - let t = Abstract.follow_with_forward_ctor (Typeload.load_instance ctx ptp ParamSpawnMonos) in + let t = Abstract.follow_with_forward_ctor (Typeload.load_instance ctx ptp ParamSpawnMonos LoadNormal) in handle_call (find_constructor_types t) el ptp.pos_full | EArray(e1,e2) -> let e1 = type_expr ctx e1 WithType.value in From aaf9b43769ba943d0e87e5fc1ba9e82e6dba4fc2 Mon Sep 17 00:00:00 2001 From: Simon Krajewski Date: Wed, 7 Feb 2024 15:08:30 +0100 Subject: [PATCH 51/51] [server] share one reader API across whole context I don't see why we would have to recreate this for every module because it only depends on com and cc, and carries no additional state. --- src/compiler/server.ml | 9 ++++++++- src/context/common.ml | 3 +++ 2 files changed, 11 insertions(+), 1 deletion(-) diff --git a/src/compiler/server.ml b/src/compiler/server.ml index 636c5cfe4ae..98c0855b26d 100644 --- a/src/compiler/server.ml +++ b/src/compiler/server.ml @@ -564,7 +564,14 @@ and type_module sctx com mpath p = begin match check_module sctx 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 com cc :> HxbReaderApi.hxb_reader_api) in + let api = match com.hxb_reader_api with + | Some api -> + api + | None -> + let api = (new hxb_reader_api_server com cc :> HxbReaderApi.hxb_reader_api) in + com.hxb_reader_api <- Some api; + 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 diff --git a/src/context/common.ml b/src/context/common.ml index ffcb5f91d06..503af30ea7f 100644 --- a/src/context/common.ml +++ b/src/context/common.ml @@ -419,6 +419,7 @@ type context = { (* misc *) mutable basic : basic_types; memory_marker : float array; + mutable hxb_reader_api : HxbReaderApi.hxb_reader_api option; hxb_reader_stats : HxbReader.hxb_reader_stats; mutable hxb_writer_config : HxbWriterConfig.t option; } @@ -844,6 +845,7 @@ let create compilation_step cs version args display_mode = has_error = false; report_mode = RMNone; is_macro_context = false; + hxb_reader_api = None; hxb_reader_stats = HxbReader.create_hxb_reader_stats (); hxb_writer_config = None; } in @@ -896,6 +898,7 @@ let clone com is_macro_context = overload_cache = new hashtbl_lookup; module_lut = new module_lut; fake_modules = Hashtbl.create 0; + hxb_reader_api = None; hxb_reader_stats = HxbReader.create_hxb_reader_stats (); std = null_class; empty_class_path = new ClassPath.directory_class_path "" User;