Merge branch 'development' into MFromMacroInMacro

# Conflicts:
#	src/context/typecore.ml
#	src/typing/matcher.ml

.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:
@@ -616,23 +616,16 @@ jobs:
       - name: Install dependencies
         env:
           # For compatibility with macOS 10.13
-          ZLIB_VERSION: 1.3
+          ZLIB_VERSION: 1.3.1
           MBEDTLS_VERSION: 2.28.5
           PCRE2_VERSION: 10.42
         run: |
           set -ex
-          brew uninstall [email protected] || echo
-          brew uninstall [email protected] || echo
-          brew untap local/openssl || echo
-          brew untap local/python2 || echo
           brew update
-          # brew unlink python@2
-          brew bundle --file=tests/Brewfile --no-upgrade || brew link --overwrite awscli
-          brew install libunistring
-          brew install cpanminus
+          brew bundle --file=tests/Brewfile --no-upgrade
           cpanm IPC::System::Simple
           cpanm String::ShellQuote
-          curl -L https://www.zlib.net/zlib-$ZLIB_VERSION.tar.gz | tar xz
+          curl -L https://github.com/madler/zlib/releases/download/v$ZLIB_VERSION/zlib-$ZLIB_VERSION.tar.gz | tar xz
           cd zlib-$ZLIB_VERSION
           ./configure
           make && make install
@@ -697,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:
@@ -794,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:
@@ -888,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

.vscode/schemas/meta.schema.json

@@ -29,8 +29,7 @@
 						"flash",
 						"php",
 						"cpp",
-						"cs",
-						"java",
+						"jvm",
 						"python",
 						"hl",
 						"eval"

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

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):

README.md

@@ -21,8 +21,6 @@ Haxe allows you to compile for the following targets:
 
  * JavaScript
  * C++
- * C#
- * Java
  * JVM
  * Lua
  * PHP 7

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)

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;

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

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

extra/github-actions/build-mac.yml

@@ -1,23 +1,16 @@
 - name: Install dependencies
   env:
     # For compatibility with macOS 10.13
-    ZLIB_VERSION: 1.3
+    ZLIB_VERSION: 1.3.1
     MBEDTLS_VERSION: 2.28.5
     PCRE2_VERSION: 10.42
   run: |
     set -ex
-    brew uninstall [email protected] || echo
-    brew uninstall [email protected] || echo
-    brew untap local/openssl || echo
-    brew untap local/python2 || echo
     brew update
-    # brew unlink python@2
-    brew bundle --file=tests/Brewfile --no-upgrade || brew link --overwrite awscli
-    brew install libunistring
-    brew install cpanminus
+    brew bundle --file=tests/Brewfile --no-upgrade
     cpanm IPC::System::Simple
     cpanm String::ShellQuote
-    curl -L https://www.zlib.net/zlib-$ZLIB_VERSION.tar.gz | tar xz
+    curl -L https://github.com/madler/zlib/releases/download/v$ZLIB_VERSION/zlib-$ZLIB_VERSION.tar.gz | tar xz
     cd zlib-$ZLIB_VERSION
     ./configure
     make && make install

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

extra/haxelib_src

@@ -1 +1 @@
-Subproject commit 70ff6b69a5b35049d767056555c0bf7a54e8ad4e
+Subproject commit 98637027327d8cf385d302acaaf104bd6107d2bf

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
@@ -23,6 +23,8 @@
 	- If everything was working, run the command again without `--dry`
 - 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
 

haxe.opam

@@ -20,7 +20,7 @@ install: [make "install" "INSTALL_DIR=%{prefix}%"]
 remove: [make "uninstall" "INSTALL_DIR=%{prefix}%"]
 depends: [
   ("ocaml" {>= "5.0"} & ("camlp5" {build}))
-    | ("ocaml" {>= "4.08" & < "5.0"} & ("camlp5" {build & = "8.00"}))
+    | ("ocaml" {>= "4.08" & < "5.0"} & ("camlp5" {build & = "8.00.03"}))
   "ocamlfind" {build}
   "dune" {>= "1.11"}
   "sedlex" {>= "2.0"}

libs/Makefile

@@ -1,7 +1,7 @@
 OCAMLOPT = ocamlopt
 OCAMLC = ocamlc
 TARGET_FLAG = all
-LIBS=extlib-leftovers extc neko javalib ilib swflib ttflib objsize pcre2 ziplib
+LIBS=extlib-leftovers extc neko javalib ilib swflib objsize pcre2 ziplib
 
 all: $(LIBS)
 $(LIBS):
@@ -14,7 +14,6 @@ clean:
 	$(MAKE) -C javalib clean
 	$(MAKE) -C ilib clean
 	$(MAKE) -C swflib clean
-	$(MAKE) -C ttflib clean
 	$(MAKE) -C objsize clean
 	$(MAKE) -C pcre2 clean
 	$(MAKE) -C ziplib clean

libs/ilib/Makefile

@@ -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): ;

libs/ilib/dump.ml

@@ -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 <exe-path>"
-	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()

libs/ilib/dune

@@ -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)
-)

libs/ilib/ilData.mli

@@ -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;
-}

libs/ilib/ilMeta.mli

@@ -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 <underlying type><rank><num_sizes><size1>...<sizeN>
-			          <num_lower_bounds><lower_bound1>...<lower_boundM> *)
-			(* <rank> is the number of dimensions (K>0) *)
-			(* <num_sizes> num of specified sizes for dimensions (N <= K) *)
-			(* <num_lower_bounds> num of lower bounds (M <= K) *)
-			(* all int values are compressed *)
-	| SGenericInst of ilsig * (ilsig list) (* 0x15 *)
-		(* A generic type instantiation. encoded like: *)
-			(* SGenericInst <type> <type-arg-count> <type1>...<typeN> *)
-	| 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 <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 <variant-type> *)
-	| NFixedArray of int * variantsig (* 0x1E *)
-		(* fixed-size array, of size <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 (<class_str>, <cookie_str>) *)
-	| NError (* 0x2D *)
-		(* maps in32 to VT_HRESULT *)
-  | NCustom of int
-
-and variantsig =
-	| VT_EMPTY (* 0x00 *)
-		(* No <empty> *)
-	| 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 <v_type> vector *) *)
-	(* | VT_ARRAY of variantsig (* 0x2000 *) *)
-	(* 	(* Yes <v_type> [ ] *) *)
-	(* | VT_BYREF of variantsig (* 0x4000 *) *)
-	(* 	(* Yes <v_type> & *) *)

libs/ilib/ilMetaDebug.ml

@@ -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

libs/ilib/ilMetaReader.ml

@@ -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 = "<not initialized>"
-
-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;
-	}
-

libs/ilib/ilMetaTools.ml

@@ -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;
-	}

libs/ilib/ilMetaWriter.ml

@@ -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

libs/ilib/peData.ml

@@ -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 *)
-}

libs/ilib/peDataDebug.ml

@@ -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))

libs/ilib/peReader.ml

@@ -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);
-	}

libs/ilib/peWriter.ml

@@ -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

libs/javalib/Makefile

@@ -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): ;

libs/javalib/dune

@@ -1,13 +0,0 @@
-(include_subdirs no)
-
-(env
-	(_
-		(flags (-w -50))
-	)
-)
-
-(library
-	(name javalib)
-	(libraries extlib)
-	(wrapped false)
-)

libs/javalib/jData.ml

@@ -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 <init> *)
-  | 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 "<init>" and "<clinit>" 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}"
-

libs/javalib/jReader.ml

@@ -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;
-  }
-

libs/javalib/jWriter.ml

@@ -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 "<init>" and "<clinit>" 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
-;;
-

libs/ocamake/ocamake.dsp

@@ -1,66 +0,0 @@
-# Microsoft Developer Studio Project File - Name="ocamake" - Package Owner=<4>
-# Microsoft Developer Studio Generated Build File, Format Version 6.00
-# ** DO NOT EDIT **
-
-# TARGTYPE "Win32 (x86) External Target" 0x0106
-
-CFG=ocamake - Win32 Native code
-!MESSAGE This is not a valid makefile. To build this project using NMAKE,
-!MESSAGE use the Export Makefile command and run
-!MESSAGE 
-!MESSAGE NMAKE /f "ocamake.mak".
-!MESSAGE 
-!MESSAGE You can specify a configuration when running NMAKE
-!MESSAGE by defining the macro CFG on the command line. For example:
-!MESSAGE 
-!MESSAGE NMAKE /f "ocamake.mak" CFG="ocamake - Win32 Native code"
-!MESSAGE 
-!MESSAGE Possible choices for configuration are:
-!MESSAGE 
-!MESSAGE "ocamake - Win32 Native code" (based on "Win32 (x86) External Target")
-!MESSAGE 
-
-# Begin Project
-# PROP AllowPerConfigDependencies 0
-# PROP Scc_ProjName ""
-# PROP Scc_LocalPath ""
-# PROP BASE Use_MFC 0
-# PROP BASE Use_Debug_Libraries 0
-# PROP BASE Output_Dir ""
-# PROP BASE Intermediate_Dir ""
-# PROP BASE Cmd_Line "ocamake -opt ocamake.dsp -o ocamake.exe"
-# PROP BASE Rebuild_Opt "-all"
-# PROP BASE Target_File "ocamake_opt.exe"
-# PROP BASE Bsc_Name ""
-# PROP BASE Target_Dir ""
-# PROP Use_MFC 0
-# PROP Use_Debug_Libraries 0
-# PROP Output_Dir ""
-# PROP Intermediate_Dir ""
-# PROP Cmd_Line "ocamake str.cmxa unix.cmxa -opt ocamake.dsp -o ocadbg.exe"
-# PROP Rebuild_Opt "-all"
-# PROP Target_File "ocadbg.exe"
-# PROP Bsc_Name ""
-# PROP Target_Dir ""
-# Begin Target
-
-# Name "ocamake - Win32 Native code"
-
-!IF  "$(CFG)" == "ocamake - Win32 Native code"
-
-!ENDIF 
-
-# Begin Group "ML Files"
-
-# PROP Default_Filter "ml;mly;mll"
-# Begin Source File
-
-SOURCE=.\ocamake.ml
-# End Source File
-# End Group
-# Begin Group "MLI Files"
-
-# PROP Default_Filter "mli"
-# End Group
-# End Target
-# End Project

libs/ocamake/ocamake.dsw

@@ -1,29 +0,0 @@
-Microsoft Developer Studio Workspace File, Format Version 6.00
-# WARNING: DO NOT EDIT OR DELETE THIS WORKSPACE FILE!
-
-###############################################################################
-
-Project: "ocamake"=.\ocamake.dsp - Package Owner=<4>
-
-Package=<5>
-{{{
-}}}
-
-Package=<4>
-{{{
-}}}
-
-###############################################################################
-
-Global:
-
-Package=<5>
-{{{
-}}}
-
-Package=<3>
-{{{
-}}}
-
-###############################################################################
-

libs/ocamake/ocamake.html

@@ -1,94 +0,0 @@
-<html>
-<body bgcolor="#ffffff" link="Black" vlink="Black">
-<center><b><font color="#000099" size="+2">OCamake</font></b></center>
-<br>
-<font color="#777777">
-	OCamake - Copyright (c)2002-2003 Nicolas Cannasse & Motion Twin.<br>
-	The last version of this software can be found at : <a href="http://tech.motion-twin.com">http://tech.motion-twin.com</a><br><br>
-	This software is provided "AS IS" without any warranty of any kind, merchantability or fitness for a particular purpose. You should use it at your own risks, as the author and his company won't be responsible for any problem that the usage of this software could raise.
-</font>
-<br>
-<br>
-
-<ul>
-
-<li><b><font color="#000099">Introduction:</font></b><br>
-<br>
-OCamake is an automatic compiler for the Objective Caml language. It removes pain from the user which does not need anymore to write a Makefile. OCamake can work either as an application which compile your program or as a Makefile generator (using the <code>-mak</code> flag). OCamake has also special features for integration under Microsoft Visual Studio.
-<br>
-<br>
-<li><b><font color="#000099">Installation:</font></b><br>
-<br>
-OCamake is a source-only distribution, so you need to compile it first. Type the following command-line:<br>
-&nbsp;&nbsp;<code>ocamlc unix.cma str.cma ocamake.ml -o ocamake.exe</code><br>
-This should produce a file "<code>ocamake.exe</code>". Copy this file in your <code>ocaml/bin</code> directory.<br>
-<br>
-<li><b><font color="#000099">Usage:</font></b><br>
-<br>
-To compile your project, simply call OCamake with the files you want to compile:<br>
-&nbsp;&nbsp;<code>ocamake *.ml *.mli</code><br>
-<br>
-To remove all intermediate files that have been produced by the compiler :<br>
-&nbsp;&nbsp;<code>ocamake -clean *.ml *.mli</code><br>
-<br>
-To generate a Makefile:<br>
-&nbsp;&nbsp;<code>ocamake -mak *.ml *.mli</code><br>
-&nbsp;&nbsp;<code>make all</code><br>
-&nbsp;&nbsp;<code>...</code><br>
-&nbsp;&nbsp;<code>make clean</code><br>
-<br>
-(Windows users can use <code>nmake</code> instead of make and should use <code>nmake wclean</code> to remove intermediate files)
-<br>
-<br>
-<li><b><font color="#000099">Features:</font></b><br>
-<br>
-OCamake works with the following files :
-<ul>
-	<li><code>ml, mli</code> : theses files are added to the list of files to build
-	<li><code>cmo, cmx, cma, cmxa, dll, so, lib, a, o, obj</code> : theses files are added to the library list
-	<li><code>mll, mly</code> : theses files are compiled using <code>ocamllex</code> and <code>ocamlyacc</code>, and their result are added to the list of files to build.
-	<li><code>dsp, vcproj</code> (Visual Studio Project) : all the files included in the project are added to the ocamake file list.
-</ul>
-<br>
-Once the final file list is made, OCamake run <code>ocamldep</code> to build module dependencies tree, and then build and link the tree in the good order (for more information on the algorithm used, see sources).
-Only modified sources files or files with one dependency modified are rebuilt.<br>
-<br>
-If one <code>dsp</code> file has been found or if the <code>-epp</code> flag has been set, then all compilation errors are processed by OCamake to transform them into a Visual Studio compatible format.<br>
-If one <code>dsp</code> file has been found or if the <code>-cpp</code> flag has been set, the character ranges in Ocaml errors are replaced by the corresponding expression found in the source file.
-<br>
-<br>
-<li><b><font color="#000099">Options:</font></b><br>
-<br>
-The following command-line options are available :
-<ul>
-	<li><code>-clean</code> : delete all the intermediate and ouput files for the target build.
-	<li><code>-mak</code> : generate a <code>Makefile</code> for this project (<i>still experimental</i>).
-	<li><code>-opt</code> : turn on native compilation.
-	<li><code>-a</code> : build a library (<code>cma or cmxa</code>).
-	<li><code>-o &lt;output&gt;</code> : set the output file for the project.
-	<li><code>-all</code> : rebuild the entire project.
-	<li><code>-cpp</code> : convert characters range in errors to file expression.
-	<li><code>-epp</code> : use MSVC error messages format.
-	<li><code>-g</code> : compile and link in debug mode.
-	<li><code>-pp &lt;command&gt;</code> : pipe source through preprocessor.
-	<li><code>-cp &lt;flag&gt;</code> : add this flag to the compiler command line paramaters.
-	<li><code>-lp &lt;flag&gt;</code> : add this flag to the linker command line paramaters.
-	<li><code>-I &lt;path&gt;</code> : add the path to the list of include directories.
-	<li><code>-n &lt;file&gt;</code> : remove that file from the file list : this can be useful when you want to have all the files but one (<code>ocamake -n myfile.ml *.ml *.mli</code>).
-	<li><code>-v</code> : verbose mode - this print all the commands that ocamake is running in order to build the project.
-	<li><code>-P &lt;file&gt;</code> : add priority to a given file when having cycle between modules.
-</ul>
-<br>
-<li><b><font color="#000099">Licence:</font></b><br>
-<br>
-The full source code of OCamake is included, so you can modify, use, and redistribute it as you want for any usage conform to the licence. This code is under the LGPL (GNU Lesser General Public Licence), you can get more information on www.gnu.org.<br>
-<br>
-<li><b><font color="#000099">Author:</font></b><br>
-<br>
-Nicolas Cannasse <a href="mailto:[email protected]">[email protected]</a><br>
-Website : <a href="http://tech.motion-twin.com">http://tech.motion-twin.com</a><br>
-Thanks to <a href="http://www.lexifi.com">Lexifi</a>.
-<br>
-<br>
-</body>
-</html>

libs/ocamake/ocamake.ml

@@ -1,661 +0,0 @@
-(* ************************************************************************ *)
-(*                                                                          *)
-(* OCAMAKE - OCaml Automatic compilation                                    *)
-(*      (c)2002 Nicolas Cannasse                                            *)
-(*      (c)2002 Motion-Twin                                                 *)
-(*                                                                          *)
-(* Last version : http://tech.motion-twin.com                               *)
-(*                                                                          *)
-(* ************************************************************************ *)
-open Unix
-open Printf
-open Arg
-
-type compile_mode =
-	| CM_DEFAULT
-	| CM_BYTE
-	| CM_OPT
-
-type file_ext =
-	| ML | MLI | MLL | MLY
-	| CMO | CMX | CMA | CMXA
-	| DLL | SO | EXE | LIB
-	| CMI | O | OBJ | A
-
-type file = {
-	name : string;
-	ext : file_ext;
-	target : string;
-	deps : string list;
-}
-
-(* ************************************************************************ *)
-(* GLOBALS *)
-
-let verbose = ref false (* print command calls in verbose mode *)
-let project_name = ref None (* for VC++ DSP *)
-let error_process = ref false (* VC++ error message processing *)
-let chars_process = ref false (* replace chars range in errors by file data *)
-
-(* ************************************************************************ *)
-(* USEFUL FUNCTIONS *)
-
-let if_some f opt def =
-	match opt with
-	| None -> def
-	| Some v -> f v
-
-let print str = print_endline str; flush Pervasives.stdout
-
-let (???) file =
-	failwith ("Don't know what to do with file " ^ file)
-
-let str_suffix = function
-	| ML -> "ml" | MLI -> "mli" | MLL -> "mll" | MLY -> "mly" | CMO -> "cmo"
-	| CMX -> "cmx" | CMA -> "cma" | CMXA -> "cmxa" | DLL -> "dll" | SO -> "so"
-	| EXE -> "exe" | CMI -> "cmi" | O -> "o" | A -> "a" | OBJ -> "obj"
-	| LIB -> "lib"
-
-let unescape file =
-	let l = String.length file in
-	if l >= 2 && file.[0] = '"' && file.[l-1] = '"' then String.sub file 1 (l-2) else file
-
-let extension file =
-	let rsplit_char str ch =
-		let p = String.rindex str ch in
-		let len = String.length str in
-		(String.sub str 0 p, String.sub str (p + 1) (len - p - 1))	
-	in
-	let file = unescape file in
-	let s = try snd(rsplit_char file '.') with Not_found -> "" in
-	String.uppercase s
-
-let (+!) file suff =
-	let base = Filename.chop_extension file in
-	base ^ "." ^ str_suffix suff
-
-let filter_all_in func ic =
-	let rec treat acc =
-	try
-		match func (input_line ic) with
-		| None -> treat acc
-		| Some data -> treat (data :: acc)
-	with
-		End_of_file -> close_in ic; acc
-	in
-	List.rev (treat [])
-
-let rec remove_duplicates = function
-	| [] -> []
-	| item :: q when List.exists ((=) item) q -> remove_duplicates q
-	| item :: q -> item :: remove_duplicates q
-
-let file_time fname =
-	try (Unix.stat fname).st_mtime with Unix_error _ -> 0.
-
-let flatten = String.concat " "
-
-let escape str =
-	try
-		ignore(String.index str ' ');
-		"\"" ^ str ^ "\"";
-	with Not_found -> str
-
-let delete_file file =
-	try Sys.remove file with Sys_error _ -> ()
-
-let check_existence (ext,name) =
-	match ext with
-	| ML | MLI ->
-		if not (Sys.file_exists name) then
-			failwith ("No such file : "^(escape name))
-	| _ -> ()
-		(* Others files can be found in Ocaml stdlib or
-		   user -I paths *)
-
-exception Found_pos of int
-
-let print_errors output msg =
-	let split str sep =
-		let find_sub str sub =
-			let len = String.length sub in
-			try
-				for i = 0 to String.length str - len do
-					if String.sub str i len = sub then raise (Found_pos i);
-				done;
-				raise Not_found
-			with Found_pos i -> i 
-		in
-		let p = find_sub str sep in
-		let len = String.length sep in
-		let slen = String.length str in
-		(String.sub str 0 p, String.sub str (p + len) (slen - p - len))
-	in
-	let process_chars file chars line =
-		let cmin, cmax = split chars "-" in
-		let cmin, cmax = int_of_string cmin, int_of_string cmax in
-		if cmax > cmin then begin
-			let f = open_in file in
-			for i = 1 to line-1 do ignore(input_line f) done;
-			seek_in f ((pos_in f)+cmin);
-			let s = String.create (cmax - cmin) in
-			ignore(input f s 0 (cmax - cmin));
-			prerr_endline (try
-					(String.sub s 0 (String.index s '\n'))^"..."
-				with
-					Not_found -> s);
-		end
-	in
-	let printer =
-		(match !error_process , !chars_process with
-		| true , _ -> (function line ->
-			try
-				let data, chars = split line ", characters " in
-				let data, lnumber = split data "\", line " in
-				let _, file = split data "File \"" in
-				prerr_string (file ^ "(" ^ lnumber ^ ") : ");
-				let chars, _ = split chars ":" in
-				if !chars_process then
-					(try process_chars file chars (int_of_string lnumber) with _ -> raise Not_found)
- 			with
-				Not_found ->
-					prerr_endline line)
-		| false , true -> (function line ->
-			try
-				let edata, chars = split line ", characters " in
-				let data, lnumber = split edata "\", line " in
-				let _, file = split data "File \"" in
-				let chars, _ = split chars ":" in
-				prerr_string (edata^" : ");
-				if !chars_process then
-					process_chars file chars (int_of_string lnumber);
- 			with
-				Not_found ->
-					prerr_endline line)
-
-		| false , false ->
-		      prerr_endline)
-	in
-	List.iter printer output;
-	failwith msg
-
-let exec ?(stdout=false) ?(outfirst=false) cmd errmsg =
-	if !verbose then print cmd;
-	let pout, pin, perr = open_process_full cmd (Unix.environment()) in
-	let read = filter_all_in (fun s -> Some s) in
-	let data, edata = 
-	(* this is made to prevent the program lock when one
-	   buffer is full and the process is waiting for us
-	   to read it before exiting... while we're reading
-	   the other output buffer ! *)
-	(if outfirst then
-		let d = read pout in
-		let ed = read perr in
-		d,ed
-	else	
-		let ed = read perr in
-		let d = read pout in
-		d,ed) in
-	match close_process_full (pout, pin, perr) with
-	| WEXITED 0 -> data,edata
-	| WEXITED exitcode -> print_errors (if stdout then edata @ data else edata) errmsg
-	| _ -> failwith "Build aborted by signal"
-
-(* ************************************************************************ *)
-(* DEPENDENCIES *)
-
-let line_regexp = Str.regexp "^\\([0-9A-Za-z:_\\./\\\\-]+\\.cm[oi]\\):\\( .*\\)$"
-let dep_regexp = Str.regexp " \\([0-9A-Za-z:_\\./\\\\-]+\\.cm[oi]\\)"
-
-let build_graph opt paramlist files =
-	let srcfiles = List.filter (fun (e,_) ->
-		match e with
-		| ML | MLI -> true
-		| _ -> false) files in
-	let get_name (_,f) = escape f in
-	let file_names = flatten (List.map get_name srcfiles) in
-	let params = flatten paramlist in
-	let command = sprintf "ocamldep %s %s" params file_names in	
-	let output,_ = exec command "Failed to make dependencies" ~outfirst:true in
-	let data = String.concat "\n" output in	
-	let data = Str.global_replace (Str.regexp "\\\\\r\n") "" data in (* win *)
-	let data = Str.global_replace (Str.regexp "\\\\\n") "" data in (* unix *)		
-	let rec get_deps data p =
-		try
-			let newp = Str.search_forward dep_regexp data p in
-			let file = Str.matched_group 1 data in
-			if opt && extension file = "CMO" then 
-				(file +! CMX)::(get_deps data (newp+1))
-			else
-				file::(get_deps data (newp+1))
-		with
-			Not_found -> []
-	in
-	let rec get_lines p =		
-		try
-			let newp = Str.search_forward line_regexp data p in	
-			let file = Str.matched_group 1 data in			
-			let lines = get_deps (Str.matched_group 2 data) 0 in			
-			(Filename.basename file,lines)::(get_lines (newp+1))
-		with
-			Not_found -> []
-	in
-	let lines = get_lines 0 in
-	let init_infos (ext,fname) =
-		let deptarget = Filename.basename (match ext with
-			| ML ->  fname +! CMO
-			| MLI -> fname +! CMI
-			| _ -> fname) in
-		let target = (match ext with
-			| ML -> fname +! (if opt then CMX else CMO)
-			| MLI -> fname +! CMI
-			| _ -> fname) in
-		{
-			name = fname;
-			ext = ext;
-			target = target;
-			deps =
-				(try
-					snd (List.find (fun (n,_) -> n = deptarget) lines)
-				with
-					Not_found -> []);
-		}
-	in	
-	let deps = List.map init_infos files in
-	match !verbose with
-	| false -> deps
-	| true ->
-		let print_dep d =
-			let dl = String.concat " " (List.map Filename.basename d.deps) in
-			printf "%s: %s\n" (Filename.basename d.target) dl;
-		in
-		List.iter print_dep deps;
-		deps
-
-let rec graph_topological_sort all g priority acc =
-	let has_dep where dep =	
-		List.exists (fun f -> Filename.basename f.target =
-							Filename.basename dep) where
-	in
-	let modified a b = (file_time a) < (file_time b) in
-	let is_free file = not(List.exists (has_dep g) file.deps) in
-	let rec has_priority = function
-		| [] -> raise Not_found
-		| x :: l ->
-			try
-				List.find (fun f -> x = (Filename.basename f.name)) g
-			with
-				Not_found -> has_priority l
-	in
-	let to_build file =
-		all || (* rebuild all *)
-		List.exists (has_dep acc) file.deps || (* a dep is rebuild *)
-		List.exists (modified file.target) file.deps || (* dep modified *)
-		(file_time file.target) < (file_time file.name) (* is modified *)
-	in
-	match g with
-	| [] -> acc
-	| _ ->
-		let free,g = List.partition is_free g in
-		match free with 
-		| [] ->
-			(try
-				let free = has_priority priority in
-				let g = List.filter ((<>) free) g in
-				if to_build free then
-					graph_topological_sort all g priority (acc@[free])
-				else
-					graph_topological_sort all g priority acc;
-			with Not_found ->
-				List.iter (fun f -> prerr_endline f.name) g;
-				failwith "Cycle detected in file dependencies !")
-		| _ ->
-			let to_build = List.filter to_build free in
-			graph_topological_sort all g priority (acc@to_build)
-
-(* ************************************************************************ *)
-(* COMPILATION *)
-
-let compile ?(precomp=false) opt paramlist f =
-	try
-		let command = (match f.ext with
-		| ML | MLI ->
-			let params = flatten paramlist in
-			let compiler = (if opt then "ocamlopt" else "ocamlc") in
-			sprintf "%s -c %s %s" compiler params (escape f.name)
-		| MLL when precomp -> "ocamllex " ^ (escape f.name)
-		| MLY when precomp -> "ocamlyacc " ^ (escape f.name)
-		| _ -> raise Exit) in
-		print (Filename.basename (unescape f.name));
-		let stdout,stderr = exec command "Build failed" in
-		try
-			print_errors (stderr@stdout) "";
-		with
-			Failure _ -> ()
-	with
-		Exit -> ()
-
-let pre_compile all (ext,name) =
-	match ext with
-	| MLL | MLY ->
-		let time = file_time name in
-		if time = 0. then failwith ("No such file : "^(escape name));
-		if all || (file_time (name +! ML)) < time then
-			compile ~precomp:true false [] {
-				name = name;
-				ext = ext;
-				deps = [];
-				target = "";
-			}
-	| _ -> () (* other files type does not need pre-compilation *)
-
-let clean_targets opt acc (ext,name) =	
-	match ext with
-	| MLY ->
-		(name +! ML) :: (name +! MLI) :: acc
-	| MLL ->
-		(name +! ML) :: acc
-	| ML when opt ->
-		(name +! (if Sys.os_type = "Win32" then OBJ else O)) :: (name +! CMX) :: (name +! CMI) :: acc
-	| ML ->
-		(name +! CMO) :: (name +! CMI) :: acc
-	| MLI ->
-		(name +! CMI) :: acc
-	| _ ->
-		acc
-
-(*
-	In order to link, we need to order the CMO files.
-	We currently have a ML/MLI dependency graph (in fact, tree) generated
-	by ocamldep.
-
-	To build the CMO list, we are reducing the dep-tree into one graph merging
-	corresponding ML & MLI nodes. ML-ML edges are keeped, ML-MLI edges
-	become ML-ML edges only if they do not create a cycle in the reduced
-	graph.
-
-	Then we sort the graph using topological ordering.
-*)
-let graph_reduce opt g =
-	let ext = (if opt then CMX else CMO) in
-	let rec path_exists g a b =
-		if a = b then true else
-		try
-			let f = List.find (fun f -> f.target = a) g in
-			List.exists (fun d -> path_exists g d b) f.deps
-		with
-			Not_found -> false
-	in
-	let rec deps_reduce f g = function		
-		| [] -> []
-		| dep::deps ->
-			match extension dep with
-			| "CMI" when not(path_exists g (dep +! ext) f.target) ->				
-				(dep +! ext)::(deps_reduce f g deps)
-			| "CMO" | "CMX" ->
-				dep::(deps_reduce f g deps)
-			| _ -> deps_reduce f g deps
-	in
-	let rec do_reduce g acc =
-		match g with
-		| [] -> acc
-		| f::g' ->			
-			let f = { f with deps = deps_reduce f (g@acc) f.deps } in
-			do_reduce g' (f::acc)
-	in
-	do_reduce g []	
-
-let is_lib f = match f.ext with
-	| CMA | CMXA | CMO | CMX | DLL | SO | LIB | A | O | OBJ -> true
-	| _ -> false
-
-let link opt paramlist files priority output =
-	print "Linking...";
-	let sources = List.filter (fun f -> f.ext = ML) files in
-	let libs = List.filter is_lib files in
-	let sources = graph_topological_sort true (graph_reduce opt sources) priority [] in
-	let lparams = flatten (List.map (fun f -> escape f.name) libs) in
-	let sparams = flatten (List.map (fun f -> escape f.target) sources) in
-	let params = flatten paramlist in
-	let cc = (if opt then "ocamlopt" else "ocamlc") in
-	let cmd = sprintf "%s %s %s %s -o %s" cc params lparams sparams output in
-	ignore(exec ~stdout:true cmd "Linking failed")
-
-(* ************************************************************************ *)
-(* FILE PROCESSING *)
-
-let dsp_get_files dsp_file =
-	let get_file line =
-		if String.length line > 7 && String.sub line 0 7 = "SOURCE=" then
-			Some (unescape (String.sub line 7 (String.length line-7)))
-		else
-			None
-	in
-	filter_all_in get_file (open_in dsp_file)
-
-let vcproj_get_files vcp_file =
-	let get_file line =
-		let len = String.length line in
-		let p = ref 0 in
-		while !p < len && (line.[!p] = ' ' || line.[!p] = '\t') do
-			incr p;
-		done;
-		let line = String.sub line !p (len - !p) in		
-		if String.length line > 13 && String.sub line 0 13 = "RelativePath=" then begin
-			let str = String.sub line 13 (String.length line - 14) in
-			Some (unescape str)
-		end else
-			None
-	in
-	filter_all_in get_file (open_in vcp_file)
-
-let rec list_files errors file =
-	match extension file with
-	| "ML" -> [(ML,file)]
-	| "MLI" -> [(MLI,file)]
-	| "VCPROJ" ->
-		project_name := Some (Filename.basename file);
-		error_process := true;
-		chars_process := true;
-		List.concat (List.map (list_files false) (vcproj_get_files file))
-	| "DSP" ->
-		project_name := Some (Filename.basename file);
-		error_process := true;
-		chars_process := true;
-		List.concat (List.map (list_files false) (dsp_get_files file))
-	| "CMA" -> [(CMA,file)]
-	| "CMXA" -> [(CMXA,file)]
-	| "CMX" -> [(CMX,file)]	
-	| "CMO" -> [(CMO,file)]
-	| "DLL" -> [(DLL,file)]
-	| "LIB" -> [(LIB,file)]
-	| "A" -> [(A,file)]
-	| "O" -> [(O,file)]
-	| "OBJ" -> [(OBJ,file)]
-	| "SO" -> [(SO,file)]
-	| "MLY" -> [(MLY,file);(ML,file +! ML);(MLI,file +! MLI)]
-	| "MLL" -> [(MLL,file);(ML,file +! ML)]	
-	| _ -> if errors then ??? file else []
-
-let rec get_compile_mode cm = function
-	| [] -> cm
-	| (ext,name)::files ->
-		let error() = failwith "Mixed bytecode and native compilation files." in
-		match ext with
-		| ML | MLI | MLL | MLY | DLL | SO ->
-			get_compile_mode cm files
-		| CMA | CMO ->
-			if cm = CM_OPT then error() else get_compile_mode CM_BYTE files
-		| CMXA | CMX | A | O | OBJ | LIB ->
-			if cm = CM_BYTE then error() else get_compile_mode CM_OPT files
-		| EXE | CMI ->
-			assert false
-
-let rec get_output_file islib cm =
-	match !project_name,islib,cm with
-	| None, _ , _ -> None
-	| Some name,false,_ -> Some (name +! EXE)
-	| Some name,true,CM_OPT -> Some (name +! CMXA)
-	| Some name,true,_ -> Some (name +! CMA)
-
-(* ************************************************************************ *)
-(* MAIN *)
-
-;;
-try
-
-let usage =
-	"OCAMAKE v1.4 - Copyright (C)2002-2005 Nicolas Cannasse"
-	^"\r\nLast version : http://tech.motion-twin.com" in
-let compile_mode = ref CM_DEFAULT in
-let compile_cma = ref false in
-let do_clean = ref false in
-let gen_make = ref false in
-let rebuild_all = ref false in
-let output_file = ref None in
-let preprocessor = ref None in
-let argfiles = ref [] in
-let paths = ref [] in
-let cflags = ref [] in
-let lflags = ref [] in
-let remf = ref [] in
-let priority = ref [] in
-let arg_spec = [
-  ("-all", Unit (fun () -> rebuild_all := true), ": rebuild all files");
-  ("-o", String (fun f -> output_file := Some f), "<file> : set output");
-  ("-a", Unit (fun () -> compile_cma := true), ": build a library");
-  ("-opt", Unit (fun () -> compile_mode := CM_OPT), ": native compilation");
-  ("-clean", Unit (fun () -> do_clean := true), ": delete intermediate files");
-  ("-I", String (fun p -> paths := p::!paths), "<path> : additional path");
-  ("-v", Unit (fun () -> verbose := true), ": turn on verbose mode");
-  ("-n", String (fun f -> remf := f::!remf),"<file>: don't compile this file");
-  ("-mak", Unit (fun () -> gen_make := true), ": generate Makefile");
-  ("-lp", String (fun f -> lflags := f::!lflags), "<p> : linker parameter");
-  ("-cp", String (fun f -> cflags := f::!cflags), "<p> : compiler parameter");
-  ("-pp", String (fun c -> preprocessor := Some c), "<cmd> : preprocessor");
-  ("-epp", Unit (fun() -> error_process := true), ": use MSVC error messages format");
-  ("-cpp", Unit (fun() -> chars_process := true), ": convert characters range in errors to file expression");
-  ("-g", Unit (fun () -> lflags := "-g"::!lflags; cflags := "-g"::!cflags), ": compile/link in debug mode");
-  ("-P", String (fun f -> priority := f::!priority), ": give linking priority to a file when linking ordering failed");
-] in
-Arg.parse arg_spec (fun arg -> argfiles := arg :: !argfiles) usage;
-let files = List.concat (List.map (list_files true) (List.rev !argfiles)) in
-let files = List.filter (fun (_,f) ->
-	let name = Filename.basename f in
-	not(List.exists (fun f -> Filename.basename f = name) !remf)) files in
-let compile_mode = get_compile_mode !compile_mode files in
-let output_file , compile_mode = (match !output_file with
-	| None -> get_output_file !compile_cma compile_mode , compile_mode
-	| Some file ->
-		match extension file , compile_mode with
-		| "CMA" , CM_OPT
-		| "CMXA", CM_BYTE -> failwith "Mixed bytecode and native compilation files."
-		| "CMA" , _ ->
-			compile_cma := true;
-			Some file , CM_BYTE
-		| "CMXA" , _ ->
-			compile_cma := true;
-			Some file , CM_OPT
-		| _ , _ ->
-			Some file , compile_mode)
-in
-let opt = (compile_mode = CM_OPT) in
-if !compile_cma then lflags := "-a"::!lflags;
-match files with
-  | [] -> Arg.usage arg_spec usage
-  | _ ->
-	let files = remove_duplicates files in
-	let get_path (_,f) = "-I " ^ escape (Filename.dirname f) in
-	let paths = List.map (fun p -> "-I " ^ (escape p)) !paths in
-	let paths = remove_duplicates (paths@(List.map get_path files)) in
-	let p4param = if_some (fun cmd -> "-pp " ^ (escape cmd)) !preprocessor "" in
-	match !do_clean,!gen_make with
-	| true,true ->
-		failwith "Cannot have -mak & -clean at the same time"
-	| false,false ->
-		if_some delete_file output_file ();
-		List.iter (pre_compile !rebuild_all) files;
-		List.iter check_existence files;
-		let g = build_graph opt (p4param::paths) files in
-		let files = graph_topological_sort !rebuild_all g [] [] in
-		List.iter (compile opt (!cflags @ p4param::paths)) files;
-		if_some (link opt (!lflags @ paths) g (List.rev !priority)) output_file ();
-		print "Done";
-	| true,false ->
-		print "Cleaning...";
-		if_some delete_file output_file ();
-		let to_clean = List.fold_left (clean_targets opt) [] files in
-		List.iter delete_file to_clean;
-		if opt && !compile_cma then
-			if_some (fun f -> delete_file (f +! (if Sys.os_type = "Win32" then LIB else A))) output_file ();
-	| false,true ->
-		List.iter (pre_compile !rebuild_all) files;
-		let g = build_graph opt (p4param::paths) files in
-		let out = open_out "Makefile" in
-		let fprint s = output_string out (s^"\n") in
-		let genmak f =
-			let ext = if opt then CMX else CMO in
-			match f.ext with
-			| MLL ->
-				fprint ((f.name +! ext)^": "^(f.name +! ML)^"\n")
-			| MLY ->
-				fprint ((f.name +! ext)^": "^(f.name +! ML)^"\n");
-				fprint ((f.name +! CMI)^": "^(f.name +! ML)^" "^(f.name +! MLI)^"\n")
-			| _ when f.deps <> [] ->
-				fprint (f.target^": "^(flatten f.deps)^"\n")
-			| _ ->
-				()
-		in
-		let compiles = graph_topological_sort true g [] [] in
-		let libs = List.filter is_lib compiles in
-		let cmos = List.filter (fun f -> f.ext = ML) compiles in
-		fprint "# Makefile generated by OCamake ";
-		fprint "# http://tech.motion-twin.com";
-		fprint ".SUFFIXES : .ml .mli .cmo .cmi .cmx .mll .mly";
-		fprint "";
-		fprint ("ALL_CFLAGS= $(CFLAGS) "^(flatten (!cflags @ p4param::paths)));
-		fprint ("LIBS="^(flatten (List.map (fun f -> f.name) libs)));
-		let targets = flatten (List.map (fun f -> f.target) cmos) in
-		(match output_file with
-		| None ->
-			fprint "";
-			fprint ("all: "^targets^"\n");
-		| Some out ->
-			fprint ("LFLAGS= -o "^out^" "^(flatten (!lflags @ paths)));
-			fprint "";
-			fprint ("all: "^out^"\n");
-			fprint (out^": "^targets);
-			(* I need to reuse the list of targets since $^ is for Make and $** for NMake *)
-			fprint ("\t"^(if opt then "ocamlopt" else "ocamlc")^" $(LFLAGS) $(LIBS) "^targets^"\n"));
-		List.iter genmak g;
-		fprint "";
-		fprint "clean:";
-		let cleanfiles = flatten (List.fold_left (clean_targets opt) [] files) in
-		if_some (fun o ->
-				fprint ("\trm -f "^o);
-				if opt && !compile_cma then fprint ("\trm -f "^(o +! LIB)^" "^(o +! A));
-			) output_file ();
-		fprint ("\trm -f "^cleanfiles);
-		fprint "";
-		fprint "wclean:";
-		if_some (fun o ->
-				fprint ("\t-@del "^o^" 2>NUL");
-				if opt && !compile_cma then fprint ("\t-@del "^(o +! LIB)^" "^(o +! A)^" 2>NUL");
-		) output_file ();
-		fprint ("\t-@del "^cleanfiles^" 2>NUL");
-		fprint "";
-		fprint "# SUFFIXES";
-		fprint ".ml.cmo:\n\tocamlc $(ALL_CFLAGS) -c $<\n";
-		fprint ".ml.cmx:\n\tocamlopt $(ALL_CFLAGS) -c $<\n";
-		fprint ".mli.cmi:\n\tocamlc $(ALL_CFLAGS) $<\n";
-		fprint ".mll.ml:\n\tocamllex $<\n";
-		fprint ".mly.ml:\n\tocamlyacc $<\n";
-		close_out out
-with
-	Failure msg ->
-		Pervasives.flush Pervasives.stdout;
-		prerr_endline msg;
-		Pervasives.flush Pervasives.stderr;
-		exit 1;
-
-(* ************************************************************************ *)

libs/swflib/swflib.sln

@@ -1,21 +0,0 @@
-Microsoft Visual Studio Solution File, Format Version 8.00
-Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "swflib", "swflib.vcproj", "{A9DD9D90-85E1-4FCF-8C09-42BF78942849}"
-	ProjectSection(ProjectDependencies) = postProject
-	EndProjectSection
-EndProject
-Global
-	GlobalSection(SolutionConfiguration) = preSolution
-		Bytecode = Bytecode
-		Native code = Native code
-	EndGlobalSection
-	GlobalSection(ProjectConfiguration) = postSolution
-		{A9DD9D90-85E1-4FCF-8C09-42BF78942849}.Bytecode.ActiveCfg = Bytecode|Win32
-		{A9DD9D90-85E1-4FCF-8C09-42BF78942849}.Bytecode.Build.0 = Bytecode|Win32
-		{A9DD9D90-85E1-4FCF-8C09-42BF78942849}.Native code.ActiveCfg = Native code|Win32
-		{A9DD9D90-85E1-4FCF-8C09-42BF78942849}.Native code.Build.0 = Native code|Win32
-	EndGlobalSection
-	GlobalSection(ExtensibilityGlobals) = postSolution
-	EndGlobalSection
-	GlobalSection(ExtensibilityAddIns) = postSolution
-	EndGlobalSection
-EndGlobal

libs/swflib/swflib.vcproj

@@ -1,80 +0,0 @@
-<?xml version="1.0" encoding="Windows-1252"?>
-<VisualStudioProject
-	ProjectType="Visual C++"
-	Version="7.10"
-	Name="swflib"
-	SccProjectName=""
-	SccLocalPath=""
-	Keyword="MakeFileProj">
-	<Platforms>
-		<Platform
-			Name="Win32"/>
-	</Platforms>
-	<Configurations>
-		<Configuration
-			Name="Native code|Win32"
-			OutputDirectory="."
-			IntermediateDirectory="."
-			ConfigurationType="0"
-			UseOfMFC="0"
-			ATLMinimizesCRunTimeLibraryUsage="FALSE">
-			<Tool
-				Name="VCNMakeTool"
-				BuildCommandLine="ocamake -opt swfLib.vcproj -a -g"
-				ReBuildCommandLine="ocamake -opt swfLib.vcproj -a -g -all"
-				Output="swflib.exe"/>
-		</Configuration>
-		<Configuration
-			Name="Bytecode|Win32"
-			OutputDirectory="."
-			IntermediateDirectory="."
-			ConfigurationType="0"
-			UseOfMFC="0"
-			ATLMinimizesCRunTimeLibraryUsage="FALSE">
-			<Tool
-				Name="VCNMakeTool"
-				BuildCommandLine="ocamake -a swfLib.vcproj"
-				ReBuildCommandLine="ocamake -a swfLib.vcproj -all"
-				Output="swflib.exe"/>
-		</Configuration>
-	</Configurations>
-	<References>
-	</References>
-	<Files>
-		<File
-			RelativePath=".\actionScript.ml">
-		</File>
-		<File
-			RelativePath=".\as3.mli">
-		</File>
-		<File
-			RelativePath=".\as3code.ml">
-		</File>
-		<File
-			RelativePath=".\as3hl.mli">
-		</File>
-		<File
-			RelativePath=".\as3hlparse.ml">
-		</File>
-		<File
-			RelativePath=".\as3parse.ml">
-		</File>
-		<File
-			RelativePath=".\png.ml">
-		</File>
-		<File
-			RelativePath=".\png.mli">
-		</File>
-		<File
-			RelativePath=".\swf.ml">
-		</File>
-		<File
-			RelativePath=".\swfParser.ml">
-		</File>
-		<File
-			RelativePath=".\swfPic.ml">
-		</File>
-	</Files>
-	<Globals>
-	</Globals>
-</VisualStudioProject>

libs/ttflib/Makefile

@@ -1,31 +0,0 @@
-OCAMLOPT=ocamlopt
-OCAMLC=ocamlc
-
-FLAGS=-package extlib -safe-string -I ../extlib-leftovers -I ../swflib
-FILES=tTFData tTFParser tTFTools tTFSwfWriter tTFCanvasWriter tTFJsonWriter
-LIBS=extLib swflib unix
-
-OUTPUT=ttf
-
-all: native bytecode
-
-native: ttflib.cmxa
-
-bytecode: ttflib.cma
-
-ttflib.cmxa: $(FILES:=.ml)
-	ocamlfind $(OCAMLOPT) $(FLAGS) $(FILES:=.ml) -g -a -o ttflib.cmxa
-
-ttflib.cma: $(FILES:=.ml)
-	ocamlfind $(OCAMLC) $(FLAGS) $(FILES:=.ml) -g -a -o ttflib.cma
-
-exec:
-	ocamlfind $(OCAMLOPT) $(FLAGS) $(LIBS:=.cmxa) $(FILES:=.ml) main.ml -g -o $(OUTPUT)
-
-clean:
-	rm -rf ttflib.cmxa ttflib.cma ttflib.lib ttflib.a $(wildcard *.cmx) $(wildcard *.obj) $(wildcard *.o) $(wildcard *.cmi) $(wildcard *.cmo)
-
-.PHONY: all native bytecode clean exec
-
-Makefile: ;
-$(FILES:=.ml): ;

libs/ttflib/dune

@@ -1,14 +0,0 @@
-(include_subdirs no)
-
-(env
-	(_
-		(flags (-w -3 -w -27 -w -35))
-	)
-)
-
-(library
-	(name ttflib)
-	(libraries extlib extlib_leftovers swflib unix)
-	(modules (:standard \ main))
-	(wrapped false)
-)

libs/ttflib/main.ml

@@ -1,139 +0,0 @@
-open TTFData
-
-exception Abort
-
-let gen_hxswfml_debug fontname =
-	let xml = "<?xml version=\"1.0\" ?>
-	<swf>
-		<FileAttributes/>
-		<Custom tagId=\"75\" file=\"" ^ fontname ^ ".dat\" comment=\"DefineFont3\"/>
-		<SymbolClass id=\"1\" class=\"TestFont\" base=\"flash.text.Font\"/>
-		<DefineABC file=\"Main.swf\" isBoot=\"true\"/>
-		<ShowFrame/>
-	</swf>"
-	in
-	Std.output_file (fontname ^ ".fxml") xml;
-	if Sys.command "haxe -main Main -swf main.swf" <> 0 then failwith "Error while executing haxe";
-	if Sys.command ("hxswfml xml2swf \"" ^ fontname ^ ".fxml\" \"" ^ fontname ^ ".swf\" -no-strict") <> 0 then failwith "Error while executing hxswfml";
-	Unix.unlink (fontname ^ ".fxml");
-	Unix.unlink "main.swf"
-
-let normalize_path p =
-	let l = String.length p in
-	if l = 0 then
-		"./"
-	else begin
-		let p = String.concat "/" (ExtString.String.nsplit p "\\") in
-		match p.[l-1] with
-		| '/' -> p
-		| _ -> p ^ "/"
-	end
-
-let mk_dir_rec dir =
-	let dir = normalize_path dir in
-	let parts = ExtString.String.nsplit dir "/" in
-	let rec create acc = function
-		| [] -> ()
-		| "" :: [] -> ()
-		| d :: l ->
-			let dir = String.concat "/" (List.rev (d :: acc)) in
-			if not (Sys.file_exists dir) then Unix.mkdir dir 0o755;
-			create (d :: acc) l
-	in
-	create [] parts
-
-let exit msg =
-	prerr_endline msg;
-	raise Abort
-
-let process args =
-	let fonts = ref [] in
-	let range_str = ref "" in
-	let targets = ref [] in
-	let debug_hxswfml = ref false in
-	let args_callback s = fonts := s :: !fonts in
-	let usage = Printf.sprintf
-		"Ttf <font paths> (-swf|-canvas)"
-	in
-	let basic_args = [
-		("-range",Arg.String (fun str ->
-			range_str := str;
-		),"<str> : specifies the character range");
-		("-swf",Arg.String (fun dir ->
-			mk_dir_rec dir;
- 			let f ttf range_str =
- 				let config = {
- 					ttfc_range_str = range_str;
- 					ttfc_font_name = None;
-					ttfc_font_weight = TFWRegular;
-					ttfc_font_posture = TFPNormal;
- 				} in
-				let f2 = TTFSwfWriter.to_swf ttf config in
-				let ch = IO.output_channel (open_out_bin (dir ^ "/" ^ ttf.ttf_font_name ^ ".dat")) in
-				let b = IO.output_bits ch in
-				IO.write_i16 ch 1;
-				TTFSwfWriter.write_font2 ch b f2;
-				IO.close_out ch;
-				if !debug_hxswfml then begin
-					if not (Sys.file_exists "Main.hx") then failwith "Could not find Main.hx required for -hxswfml-debug";
-					let main = Std.input_file "Main.hx" in
-					let old = Sys.getcwd () in
-					Sys.chdir dir;
-					Std.output_file ~filename:"Main.hx" ~text:main;
-					gen_hxswfml_debug ttf.ttf_font_name;
-					Unix.unlink "Main.hx";
-					Sys.chdir old;
-				end
-			in
-			targets := f :: !targets;
-		),"<dir> : generate swf tag data to <dir>");
-		("-canvas", Arg.String (fun dir ->
-			mk_dir_rec dir;
- 			let f ttf range_str =
- 				let glyphs = TTFCanvasWriter.to_canvas ttf range_str in
-				let ch = IO.output_channel (open_out_bin (dir ^ "/" ^ ttf.ttf_font_name ^ ".js")) in
-				TTFCanvasWriter.write_font ch ttf glyphs;
-				IO.close_out ch;
-			in
-			targets := f :: !targets;
-		),"<dir> : generate canvas draw commands to <dir>");
-		("-json", Arg.String (fun dir ->
-			mk_dir_rec dir;
- 			let f ttf range_str =
- 				let glyphs = TTFJsonWriter.to_json ttf range_str in
-				let ch = IO.output_channel (open_out_bin (dir ^ "/" ^ ttf.ttf_font_name ^ ".js")) in
-				TTFJsonWriter.write_font ch ttf glyphs;
-				IO.close_out ch;
-			in
-			targets := f :: !targets;
-		),"<dir> : generate json-encoded glyph information to <dir>");
-		("-hxswfml-debug", Arg.Unit (fun () ->
-			debug_hxswfml := true;
-		),": generate debug swf with hxswfml")
-	] in
-	if Array.length Sys.argv = 1 then
-		Arg.usage basic_args usage
-	else begin
-		Arg.parse basic_args args_callback usage;
-		match !fonts,!targets with
-		| [],_ ->
-			prerr_endline "Missing font argument";
-			Arg.usage basic_args usage
-		| _,[] ->
-			prerr_endline "No targets specified (-swf|-canvas|-json)";
-			Arg.usage basic_args usage
-		| fonts,targets ->
-			List.iter (fun font ->
-				let ch = try open_in_bin font with _ -> exit ("No such file: " ^ font) in
-				let ttf = TTFParser.parse ch in
-				List.iter (fun target ->
-					target ttf !range_str
-				) targets;
-				close_in ch;
-			) fonts;
-	end
-;;
-try
-	process Sys.argv;
-with Abort ->
-	()

libs/ttflib/tTFCanvasWriter.ml

@@ -1,50 +0,0 @@
-(*
- * Copyright (C)2005-2014 Haxe Foundation
- *
- * Permission is hereby granted, free of charge, to any person obtaining a
- * copy of this software and associated documentation files (the "Software"),
- * to deal in the Software without restriction, including without limitation
- * the rights to use, copy, modify, merge, publish, distribute, sublicense,
- * and/or sell copies of the Software, and to permit persons to whom the
- * Software is furnished to do so, subject to the following conditions:
- *
- * The above copyright notice and this permission notice shall be included in
- * all copies or substantial portions of the Software.
- *
- * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
- * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
- * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
- * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
- * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
- * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
- * DEALINGS IN THE SOFTWARE.
- *)
-
-open TTFData
-open TTFTools
-
-let rec write_glyph ttf key glyf =
-	key,TTFTools.build_glyph_paths ttf false glyf
-
-let write_font ch ttf glyphs =
-	let scale = 1024. /. (float_of_int ttf.ttf_head.hd_units_per_em) in
-	List.iter (fun (key,paths) ->
-		IO.nwrite_string ch (Printf.sprintf "\tfunction key%i(ctx) {\n" key);
-		IO.nwrite_string ch "\t\tctx.beginPath();\n";
-		List.iter (fun path ->
-			IO.nwrite_string ch (match path.gp_type with
-			| 0 -> Printf.sprintf "\t\tctx.moveTo(%.2f,%.2f);\n" (path.gp_x *. scale) (path.gp_y *. scale *. (-1.))
-			| 1 -> Printf.sprintf "\t\tctx.lineTo(%.2f,%.2f);\n" (path.gp_x *. scale) (path.gp_y *. scale *. (-1.))
-			| 2 -> Printf.sprintf "\t\tctx.quadraticCurveTo(%.2f,%.2f,%.2f,%.2f);\n" (path.gp_cx *. scale) (path.gp_cy *. scale *. (-1.)) (path.gp_x *. scale) (path.gp_y *. scale *. (-1.))
-			| _ -> assert false)
-		) paths;
-		IO.nwrite_string ch "\t\tctx.fill();\n";
-		IO.nwrite_string ch "\t}\n";
-	) glyphs;
-	()
-
-let to_canvas ttf range_str =
-	let lut = TTFTools.build_lut ttf range_str in
-	let glyfs = Hashtbl.fold (fun k v acc -> (k,ttf.ttf_glyfs.(v)) :: acc) lut [] in
-	let glyfs = List.stable_sort (fun a b -> compare (fst a) (fst b)) glyfs in
-	List.map (fun (k,g) -> write_glyph ttf k g) glyfs

libs/ttflib/tTFData.ml

@@ -1,360 +0,0 @@
-(*
- * Copyright (C)2005-2014 Haxe Foundation
- *
- * Permission is hereby granted, free of charge, to any person obtaining a
- * copy of this software and associated documentation files (the "Software"),
- * to deal in the Software without restriction, including without limitation
- * the rights to use, copy, modify, merge, publish, distribute, sublicense,
- * and/or sell copies of the Software, and to permit persons to whom the
- * Software is furnished to do so, subject to the following conditions:
- *
- * The above copyright notice and this permission notice shall be included in
- * all copies or substantial portions of the Software.
- *
- * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
- * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
- * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
- * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
- * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
- * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
- * DEALINGS IN THE SOFTWARE.
- *)
-
-type header = {
-	hd_major_version : int;
-	hd_minor_version : int;
-	hd_num_tables : int;
-	hd_search_range : int;
-	hd_entry_selector : int;
-	hd_range_shift : int;
-}
-
-type entry = {
-	entry_table_name : string;
-	entry_checksum : int32;
-	entry_offset : int32;
-	entry_length: int32;
-}
-
-(* GLYF *)
-
-type glyf_header = {
-	gh_num_contours : int;
-	gh_xmin : int;
-	gh_ymin : int;
-	gh_xmax : int;
-	gh_ymax : int;
-}
-
-type glyf_simple = {
-	gs_end_pts_of_contours : int array;
-	gs_instruction_length : int;
-	gs_instructions : char array;
-	gs_flags : int array;
-	gs_x_coordinates : int array;
-	gs_y_coordinates : int array;
-}
-
-type transformation_option =
-	| NoScale
-	| Scale of float
-	| ScaleXY of float * float
-	| ScaleMatrix of float * float * float * float
-
-type glyf_component = {
-	gc_flags : int;
-	gc_glyf_index : int;
-	gc_arg1 : int;
-	gc_arg2 : int;
-	gc_transformation : transformation_option;
-}
-
-type glyf =
-	| TGlyfSimple of glyf_header * glyf_simple
-	| TGlyfComposite of glyf_header * glyf_component list
-	| TGlyfNull
-
-(* HMTX *)
-
-type hmtx = {
-	advance_width : int;
-	left_side_bearing : int;
-}
-
-(* CMAP *)
-
-type cmap_subtable_header = {
-	csh_platform_id : int;
-	csh_platform_specific_id : int;
-	csh_offset : int32;
-}
-
-type cmap_format_0 = {
-	c0_format : int;
-	c0_length : int;
-	c0_language : int;
-	c0_glyph_index_array : char array;
-}
-
-type cmap_format_4 = {
-	c4_format : int;
-	c4_length : int;
-	c4_language : int;
-	c4_seg_count_x2 : int;
-	c4_search_range : int;
-	c4_entry_selector : int;
-	c4_range_shift : int;
-	c4_end_code : int array;
-	c4_reserved_pad : int;
-	c4_start_code : int array;
-	c4_id_delta : int array;
-	c4_id_range_offset : int array;
-	c4_glyph_index_array : int array;
-}
-
-type cmap_format_6 = {
-	c6_format : int;
-	c6_length : int;
-	c6_language : int;
-	c6_first_code : int;
-	c6_entry_count : int;
-	c6_glyph_index_array : int array;
-}
-
-type cmap_format_12_group = {
-	c12g_start_char_code : int32;
-	c12g_end_char_code : int32;
-	c12g_start_glyph_code : int32;
-}
-
-type cmap_format_12 = {
-	c12_format : int32;
-	c12_length : int32;
-	c12_language : int32;
-	c12_num_groups : int32;
-	c12_groups : cmap_format_12_group list;
-}
-
-type cmap_subtable_def =
-	| Cmap0 of cmap_format_0
-	| Cmap4 of cmap_format_4
-	| Cmap6 of cmap_format_6
-	| Cmap12 of cmap_format_12
-	| CmapUnk of string
-
-type cmap_subtable = {
-	cs_header : cmap_subtable_header;
-	cs_def : cmap_subtable_def;
-}
-
-type cmap = {
-	cmap_version : int;
-	cmap_num_subtables : int;
-	cmap_subtables : cmap_subtable list;
-}
-
-(* KERN *)
-
-type kern_subtable_header = {
-	ksh_length : int32;
-	ksh_coverage : int;
-	ksh_tuple_index : int;
-}
-
-type kern_pair = {
-	kern_left : int;
-	kern_right : int;
-	kern_value : int;
-}
-
-type kern_format_0 = {
-	k0_num_pairs : int;
-	k0_search_range : int;
-	k0_entry_selector : int;
-	k0_range_shift : int;
-	k0_pairs : kern_pair list;
-}
-
-type kern_format_2 = {
-	k2_row_width : int;
-	k2_left_offset_table : int;
-	k2_right_offset_table : int;
-	k2_array : int;
-	k2_first_glyph : int;
-	k2_num_glyphs : int;
-	k2_offsets : int list;
-}
-
-type kern_subtable_def =
-	| Kern0 of kern_format_0
-	| Kern2 of kern_format_2
-
-type kern_subtable = {
-	ks_header : kern_subtable_header;
-	ks_def : kern_subtable_def;
-}
-
-type kern = {
-	kern_version : int32;
-	kern_num_tables : int32;
-	kern_subtables : kern_subtable list;
-}
-
-(* NAME *)
-
-type name_record = {
-	nr_platform_id : int;
-	nr_platform_specific_id : int;
-	nr_language_id : int;
-	nr_name_id : int;
-	nr_length : int;
-	nr_offset : int;
-	mutable nr_value : string;
-}
-
-type name = {
-	name_format : int;
-	name_num_records : int;
-	name_offset : int;
-	name_records : name_record array;
-}
-
-(* HEAD *)
-
-type head = {
-	hd_version : int32;
-	hd_font_revision : int32;
-	hd_checksum_adjustment : int32;
-	hd_magic_number : int32;
-	hd_flags : int;
-	hd_units_per_em : int;
-	hd_created : float;
-	hd_modified : float;
-	hd_xmin : int;
-	hd_ymin : int;
-	hd_xmax : int;
-	hd_ymax : int;
-	hd_mac_style : int;
-	hd_lowest_rec_ppem : int;
-	hd_font_direction_hint : int;
-	hd_index_to_loc_format : int;
-	hd_glyph_data_format : int;
-}
-
-(* HHEA *)
-
-type hhea = {
-	hhea_version : int32;
-	hhea_ascent : int;
-	hhea_descent : int;
-	hhea_line_gap : int;
-	hhea_advance_width_max : int;
-	hhea_min_left_side_bearing : int;
-	hhea_min_right_side_bearing : int;
-	hhea_x_max_extent : int;
-	hhea_caret_slope_rise : int;
-	hhea_caret_slope_run : int;
-	hhea_caret_offset : int;
-	hhea_reserved : string;
-	hhea_metric_data_format : int;
-	hhea_number_of_hmetrics :int;
-}
-
-(* LOCA *)
-
-type loca = int32 array
-
-(* MAXP *)
-
-type maxp = {
-	maxp_version_number : int32;
-	maxp_num_glyphs : int;
-	maxp_max_points : int;
-	maxp_max_contours : int;
-	maxp_max_component_points : int;
-	maxp_max_component_contours : int;
-	maxp_max_zones : int;
-	maxp_max_twilight_points : int;
-	maxp_max_storage : int;
-	maxp_max_function_defs : int;
-	maxp_max_instruction_defs :int;
-	maxp_max_stack_elements : int;
-	maxp_max_size_of_instructions :int;
-	maxp_max_component_elements :int;
-	maxp_max_component_depth :int;
-}
-
-(* OS2 *)
-
-type os2 = {
-	os2_version : int;
-	os2_x_avg_char_width : int;
-	os2_us_weight_class : int;
-	os2_us_width_class : int;
-	os2_fs_type : int;
-	os2_y_subscript_x_size : int;
-	os2_y_subscript_y_size : int;
-	os2_y_subscript_x_offset : int;
-	os2_y_subscript_y_offset : int;
-	os2_y_superscript_x_size : int;
-	os2_y_superscript_y_size : int;
-	os2_y_superscript_x_offset : int;
-	os2_y_superscript_y_offset : int;
-	os2_y_strikeout_size : int;
-	os2_y_strikeout_position : int;
-	os2_s_family_class : int;
-	os2_b_family_type : int;
-	os2_b_serif_style : int;
-	os2_b_weight : int;
-	os2_b_proportion : int;
-	os2_b_contrast : int;
-	os2_b_stroke_variation : int;
-	os2_b_arm_style : int;
-	os2_b_letterform : int;
-	os2_b_midline : int;
-	os2_b_x_height : int;
-	os2_ul_unicode_range_1 : int32;
-	os2_ul_unicode_range_2 : int32;
-	os2_ul_unicode_range_3 : int32;
-	os2_ul_unicode_range_4 : int32;
-	os2_ach_vendor_id : int32;
-	os2_fs_selection : int;
-	os2_us_first_char_index : int;
-	os2_us_last_char_index : int;
-	os2_s_typo_ascender : int;
-	os2_s_typo_descender : int;
-	os2_s_typo_line_gap : int;
-	os2_us_win_ascent : int;
-	os2_us_win_descent : int;
-}
-
-type ttf = {
-	ttf_header : header;
-	ttf_font_name : string;
-	ttf_directory: (string,entry) Hashtbl.t;
-	ttf_glyfs : glyf array;
-	ttf_hmtx : hmtx array;
-	ttf_cmap : cmap;
-	ttf_head : head;
-	ttf_loca : loca;
-	ttf_hhea : hhea;
-	ttf_maxp : maxp;
-	ttf_name : name;
-	ttf_os2 : os2;
-	ttf_kern : kern option;
-}
-
-type ttf_font_weight =
-	| TFWRegular
-	| TFWBold
-
-type ttf_font_posture =
-	| TFPNormal
-	| TFPItalic
-
-type ttf_config = {
-	mutable ttfc_range_str : string;
-	mutable ttfc_font_name : string option;
-	mutable ttfc_font_weight : ttf_font_weight;
-	mutable ttfc_font_posture : ttf_font_posture;
-}

libs/ttflib/tTFJsonWriter.ml

@@ -1,49 +0,0 @@
-(*
- * Copyright (C)2005-2014 Haxe Foundation
- *
- * Permission is hereby granted, free of charge, to any person obtaining a
- * copy of this software and associated documentation files (the "Software"),
- * to deal in the Software without restriction, including without limitation
- * the rights to use, copy, modify, merge, publish, distribute, sublicense,
- * and/or sell copies of the Software, and to permit persons to whom the
- * Software is furnished to do so, subject to the following conditions:
- *
- * The above copyright notice and this permission notice shall be included in
- * all copies or substantial portions of the Software.
- *
- * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
- * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
- * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
- * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
- * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
- * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
- * DEALINGS IN THE SOFTWARE.
- *)
-
-open TTFData
-open TTFTools
-
-let rec write_glyph ttf key glyf =
-	key,TTFTools.build_glyph_paths ttf false glyf
-
-let write_font ch ttf glyphs =
-	let scale = 1024. /. (float_of_int ttf.ttf_head.hd_units_per_em) in
-	IO.nwrite_string ch "{\n\t";
-	IO.nwrite_string ch (String.concat ",\n\t" (List.map (fun (key,paths) ->
-		(Printf.sprintf "\"g%i\":[" key)
-		^ (String.concat "," (List.map (fun path ->
-			match path.gp_type with
-			| 0 -> Printf.sprintf "[0,%.2f,%.2f]" (path.gp_x *. scale) (path.gp_y *. scale *. (-1.))
-			| 1 -> Printf.sprintf "[1,%.2f,%.2f]" (path.gp_x *. scale) (path.gp_y *. scale *. (-1.))
-			| 2 -> Printf.sprintf "[2,%.2f,%.2f,%.2f,%.2f]" (path.gp_cx *. scale) (path.gp_cy *. scale *. (-1.)) (path.gp_x *. scale) (path.gp_y *. scale *. (-1.))
-			| _ -> assert false
-		) paths))
-		^ "]";
-	) glyphs));
-	IO.nwrite_string ch "\n}"
-
-let to_json ttf range_str =
-	let lut = TTFTools.build_lut ttf range_str in
-	let glyfs = Hashtbl.fold (fun k v acc -> (k,ttf.ttf_glyfs.(v)) :: acc) lut [] in
-	let glyfs = List.stable_sort (fun a b -> compare (fst a) (fst b)) glyfs in
-	List.map (fun (k,g) -> write_glyph ttf k g) glyfs

libs/ttflib/tTFParser.ml

@@ -1,688 +0,0 @@
-(*
- * Copyright (C)2005-2014 Haxe Foundation
- *
- * Permission is hereby granted, free of charge, to any person obtaining a
- * copy of this software and associated documentation files (the "Software"),
- * to deal in the Software without restriction, including without limitation
- * the rights to use, copy, modify, merge, publish, distribute, sublicense,
- * and/or sell copies of the Software, and to permit persons to whom the
- * Software is furnished to do so, subject to the following conditions:
- *
- * The above copyright notice and this permission notice shall be included in
- * all copies or substantial portions of the Software.
- *
- * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
- * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
- * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
- * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
- * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
- * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
- * DEALINGS IN THE SOFTWARE.
- *)
-
-open TTFData
-open IO
-
-type ctx = {
-	file : Stdlib.in_channel;
-	ch : input;
-	mutable entry : entry;
-}
-
-let rd16 = BigEndian.read_i16
-let rdu16 = BigEndian.read_ui16
-let rd32 = BigEndian.read_i32
-let rd32r = BigEndian.read_real_i32
-
-let parse_header ctx =
-	let ch = ctx.ch in
-	let major_version = rdu16 ch in
-	let minor_version = rdu16 ch in
-	let num_tables = rdu16 ch in
-	let search_range = rdu16 ch in
-	let entry_selector = rdu16 ch in
-	let range_shift = rdu16 ch in
-	{
-		hd_major_version = major_version;
-		hd_minor_version = minor_version;
-		hd_num_tables = num_tables;
-		hd_search_range = search_range;
-		hd_entry_selector = entry_selector;
-		hd_range_shift = range_shift;
-	}
-
-let parse_directory ctx header =
-	let ch = ctx.ch in
-	let directory = Hashtbl.create 0 in
-	for i = 0 to header.hd_num_tables - 1 do
-		let name = nread_string ch 4 in
-		let cs = rd32r ch in
-		let off = rd32r ch in
-		let length = rd32r ch in
-		Hashtbl.add directory name {
-			entry_table_name = name;
-			entry_checksum = cs;
-			entry_offset = off;
-			entry_length = length;
-		}
-	done;
-	directory
-
-let parse_head_table ctx =
-	let ch = ctx.ch in
-	let version = rd32r ch in
-	let font_revision = rd32r ch in
-	let checksum_adjustment = rd32r ch in
-	let magic_number = rd32r ch in
-	let flags = rdu16 ch in
-	let units_per_em = rdu16 ch in
-	let created = BigEndian.read_double ch in
-	let modified = BigEndian.read_double ch in
-	let xmin = rd16 ch in
-	let ymin = rd16 ch in
-	let xmax = rd16 ch in
-	let ymax = rd16 ch in
-	let mac_style = rdu16 ch in
-	let lowest_rec_ppem = rdu16 ch in
-	let font_direction_hint = rd16 ch in
-	let index_to_loc_format = rd16 ch in
-	let glyph_data_format = rd16 ch in
-	{
-		hd_version = version;
-		hd_font_revision = font_revision;
-		hd_checksum_adjustment = checksum_adjustment;
-		hd_magic_number = magic_number;
-		hd_flags = flags;
-		hd_units_per_em = units_per_em;
-		hd_created = created;
-		hd_modified = modified;
-		hd_xmin = xmin;
-		hd_ymin = ymin;
-		hd_xmax = xmax;
-		hd_ymax = ymax;
-		hd_mac_style = mac_style;
-		hd_lowest_rec_ppem = lowest_rec_ppem;
-		hd_font_direction_hint = font_direction_hint;
-		hd_index_to_loc_format = index_to_loc_format;
-		hd_glyph_data_format = glyph_data_format;
-	}
-
-let parse_hhea_table ctx =
-	let ch = ctx.ch in
-	let version = rd32r ch in
-	let ascender = rd16 ch in
-	let descender = rd16 ch in
-	let line_gap = rd16 ch in
-	let advance_width_max = rdu16 ch in
-	let min_left_side_bearing = rd16 ch in
-	let min_right_side_bearing = rd16 ch in
-	let x_max_extent = rd16 ch in
-	let caret_slope_rise = rd16 ch in
-	let caret_slope_run = rd16 ch in
-	let caret_offset = rd16 ch in
-	let reserved = nread_string ch 8 in
-	let metric_data_format = rd16 ch in
-	let number_of_hmetrics = rdu16 ch in
-	{
-		hhea_version = version;
-		hhea_ascent = ascender;
-		hhea_descent = descender;
-		hhea_line_gap = line_gap;
-		hhea_advance_width_max = advance_width_max;
-		hhea_min_left_side_bearing = min_left_side_bearing;
-		hhea_min_right_side_bearing = min_right_side_bearing;
-		hhea_x_max_extent = x_max_extent;
-		hhea_caret_slope_rise = caret_slope_rise;
-		hhea_caret_slope_run = caret_slope_run;
-		hhea_caret_offset = caret_offset;
-		hhea_reserved = reserved;
-		hhea_metric_data_format = metric_data_format;
-		hhea_number_of_hmetrics = number_of_hmetrics;
-	}
-
-let parse_maxp_table ctx =
-	let ch = ctx.ch in
-	let version_number = rd32r ch in
-	let num_glyphs = rdu16 ch in
-	let max_points = rdu16 ch in
-	let max_contours = rdu16 ch in
-	let max_component_points = rdu16 ch in
-	let max_component_contours = rdu16 ch in
-	let max_zones = rdu16 ch in
-	let max_twilight_points = rdu16 ch in
-	let max_storage = rdu16 ch in
-	let max_function_defs = rdu16 ch in
-	let max_instruction_defs = rdu16 ch in
-	let max_stack_elements = rdu16 ch in
-	let max_size_of_instructions = rdu16 ch in
-	let max_component_elements = rdu16 ch in
-	let max_component_depth = rdu16 ch in
-	{
-		maxp_version_number = version_number;
-		maxp_num_glyphs = num_glyphs;
-		maxp_max_points = max_points;
-		maxp_max_contours = max_contours;
-		maxp_max_component_points = max_component_points;
-		maxp_max_component_contours = max_component_contours;
-		maxp_max_zones = max_zones;
-		maxp_max_twilight_points = max_twilight_points;
-		maxp_max_storage = max_storage;
-		maxp_max_function_defs = max_function_defs;
-		maxp_max_instruction_defs = max_instruction_defs;
-		maxp_max_stack_elements = max_stack_elements;
-		maxp_max_size_of_instructions = max_size_of_instructions;
-		maxp_max_component_elements = max_component_elements;
-		maxp_max_component_depth = max_component_depth;
-	}
-
-let parse_loca_table head maxp ctx =
-	let ch = ctx.ch in
-	if head.hd_index_to_loc_format = 0 then
-		Array.init (maxp.maxp_num_glyphs + 1) (fun _ -> Int32.of_int ((rdu16 ch) * 2))
-	else
-		Array.init (maxp.maxp_num_glyphs + 1) (fun _ -> rd32r ch)
-
-let parse_hmtx_table maxp hhea ctx =
-	let ch = ctx.ch in
-	let last_advance_width = ref 0 in (* check me 1/2*)
-	Array.init maxp.maxp_num_glyphs (fun i ->
-		let advance_width = if i > hhea.hhea_number_of_hmetrics-1 then (* check me 2/2*)
-			!last_advance_width
-		else
-			rdu16 ch
-		in
-		last_advance_width := advance_width;
-		let left_side_bearing = rd16 ch in
-		{
-			advance_width = advance_width;
-			left_side_bearing = left_side_bearing;
-		}
-	)
-
-let parse_cmap_table ctx =
-	let ch = ctx.ch in
-	let version = rdu16 ch in
-	let num_subtables = rdu16 ch in
-	let dir = ExtList.List.init num_subtables (fun _ ->
-		let platform_id = rdu16 ch in
-		let platform_specific_id = rdu16 ch in
-		let offset = rd32r ch in
-		{
-			csh_platform_id = platform_id;
-			csh_platform_specific_id = platform_specific_id;
-			csh_offset = offset;
-		}
-	) in
-	let dir = List.stable_sort (fun csh1 csh2 ->
-		if csh1.csh_platform_id < csh2.csh_platform_id then -1
-		else if csh1.csh_platform_id > csh2.csh_platform_id then 1
-		else compare csh1.csh_platform_specific_id csh2.csh_platform_specific_id
-	) dir in
-	let parse_sub entry =
-		seek_in ctx.file ((Int32.to_int ctx.entry.entry_offset) + (Int32.to_int entry.csh_offset));
-		let format = rdu16 ch in
-		let def = match format with
-			| 0 ->
-				let length = rdu16 ch in
-				let language = rdu16 ch in
-				let glyph_index = Array.init 256 (fun _ -> read ch) in
-				Cmap0 {
-					c0_format = 0;
-					c0_length = length;
-					c0_language = language;
-					c0_glyph_index_array = glyph_index;
-				}
-			| 4 ->
-				let length = rdu16 ch in
-				let language = rdu16 ch in
-				let seg_count_x2 = rdu16 ch in
-				let seg_count = seg_count_x2 / 2 in
-				let search_range = rdu16 ch in
-				let entry_selector = rdu16 ch in
-				let range_shift = rdu16 ch in
-				let end_code = Array.init seg_count (fun _ -> rdu16 ch) in
-				let reserved = rdu16 ch in
-				assert (reserved = 0);
-				let start_code = Array.init seg_count (fun _ -> rdu16 ch) in
-				let id_delta = Array.init seg_count (fun _ -> rdu16 ch) in
-				let id_range_offset = Array.init seg_count (fun _ -> rdu16 ch) in
-				let count = (length - (8 * seg_count + 16)) / 2 in
-				let glyph_index = Array.init count (fun _ -> rdu16 ch) in
-				Cmap4 {
-					c4_format = format;
-					c4_length = length;
-					c4_language = language;
-					c4_seg_count_x2 = seg_count_x2;
-					c4_search_range = search_range;
-					c4_entry_selector = entry_selector;
-					c4_range_shift = range_shift;
-					c4_end_code = end_code;
-					c4_reserved_pad = reserved;
-					c4_start_code = start_code;
-					c4_id_delta = id_delta;
-					c4_id_range_offset = id_range_offset;
-					c4_glyph_index_array = glyph_index;
-				}
-			| 6 ->
-				let length = rdu16 ch in
-				let language = rdu16 ch in
-				let first_code = rdu16 ch in
-				let entry_count = rdu16 ch in
-				let glyph_index = Array.init entry_count (fun _ -> rdu16 ch) in
-				Cmap6 {
-					c6_format = format;
-					c6_length = length;
-					c6_language = language;
-					c6_first_code = first_code;
-					c6_entry_count = entry_count;
-					c6_glyph_index_array = glyph_index;
-				}
-  			| 12 ->
-				ignore (rd16 ch);
-				let length = rd32r ch in
-				let language = rd32r ch in
-				let num_groups = rd32r ch in
-				let groups = ExtList.List.init (Int32.to_int num_groups) (fun _ ->
-					let start = rd32r ch in
-					let stop = rd32r ch in
-					let start_glyph = rd32r ch in
-					{
-						c12g_start_char_code = start;
-						c12g_end_char_code = stop;
-						c12g_start_glyph_code = start_glyph;
-					}
-				) in
-				Cmap12 {
-					c12_format = Int32.of_int 12;
-					c12_length = length;
-					c12_language = language;
-					c12_num_groups = num_groups;
-					c12_groups = groups;
-				}
-			| x ->
-				failwith ("Not implemented format: " ^ (string_of_int x));
-		in
-		{
-			cs_def = def;
-			cs_header = entry;
-		}
-
-	in
-	{
-		cmap_version = version;
-		cmap_num_subtables = num_subtables;
-		cmap_subtables = List.map parse_sub dir;
-	}
-
-let parse_glyf_table maxp loca cmap hmtx ctx =
-	let ch = ctx.ch in
-	let parse_glyf i =
-		seek_in ctx.file ((Int32.to_int ctx.entry.entry_offset) + (Int32.to_int loca.(i)));
-		let num_contours = rd16 ch in
-		let xmin = rd16 ch in
-		let ymin = rd16 ch in
-		let xmax = rd16 ch in
-		let ymax = rd16 ch in
-		let header = {
-			gh_num_contours = num_contours;
-			gh_xmin = xmin;
-			gh_ymin = ymin;
-			gh_xmax = xmax;
-			gh_ymax = ymax;
-		} in
-		if num_contours >= 0 then begin
-			let num_points = ref 0 in
-			let end_pts_of_contours = Array.init num_contours (fun i ->
-				let v = rdu16 ch in
-				if i = num_contours - 1 then num_points := v + 1;
-				v
-			) in
-			let instruction_length = rdu16 ch in
-			let instructions = Array.init instruction_length (fun _ ->
-				read ch
-			) in
-			let flags = DynArray.create () in
-			let rec loop index =
-				if index >= !num_points then () else begin
-					let v = read_byte ch in
-					let incr = if (v land 8) == 0 then begin
-						DynArray.add flags v;
-						1
-					end else begin
-						let r = (int_of_char (read ch)) in
-						for i = 0 to r do DynArray.add flags v done;
-						r + 1
-					end in
-					loop (index + incr)
-				end
-			in
-			loop 0;
-			assert (DynArray.length flags = !num_points);
-			let x_coordinates = Array.init !num_points (fun i ->
-				let flag = DynArray.get flags i in
-				if flag land 0x10 <> 0 then begin
-					if flag land 0x02 <> 0 then read_byte ch
-					else 0
-				end else begin
-					if flag land 0x02 <> 0 then -read_byte ch
-					else rd16 ch
-				end
-			) in
-			let y_coordinates = Array.init !num_points (fun i ->
-				let flag = DynArray.get flags i in
-				if flag land 0x20 <> 0 then begin
-					if flag land 0x04 <> 0 then read_byte ch
-					else 0
-				end else begin
-					if flag land 0x04 <> 0 then -read_byte ch
-					else rd16 ch
-				end;
-			) in
-			TGlyfSimple (header, {
-				gs_end_pts_of_contours = end_pts_of_contours;
-				gs_instruction_length = instruction_length;
-				gs_instructions = instructions;
-				gs_flags = DynArray.to_array flags;
-				gs_x_coordinates = x_coordinates;
-				gs_y_coordinates = y_coordinates;
-			})
-		end else if num_contours = -1 then begin
-			let acc = DynArray.create () in
-			let rec loop () =
-				let flags = rdu16 ch in
-				let glyph_index = rdu16 ch in
-				let arg1,arg2 = if flags land 1 <> 0 then begin
-					let arg1 = rd16 ch in
-					let arg2 = rd16 ch in
-					arg1,arg2
-				end else begin
-					let arg1 = read_byte ch in
-					let arg2 = read_byte ch in
-					arg1,arg2
-				end in
-				let fmt214 i = (float_of_int i) /. (float_of_int 0x4000) in
-				let fmode =	if flags land 8 <> 0 then
-					Scale (fmt214 (rd16 ch))
-				else if flags land 64 <> 0 then begin
-					let s1 = fmt214 (rd16 ch) in
-					let s2 = fmt214 (rd16 ch) in
-					ScaleXY (s1,s2)
-				end else if flags land 128 <> 0 then begin
-					let a = fmt214 (rd16 ch) in
-					let b = fmt214 (rd16 ch) in
-					let c = fmt214 (rd16 ch) in
-					let d = fmt214 (rd16 ch) in
-					ScaleMatrix (a,b,c,d)
-				end else
-					NoScale
-				in
-				DynArray.add acc {
-					gc_flags = flags;
-					gc_glyf_index = glyph_index;
-					gc_arg1 = if flags land 2 <> 0 then arg1 else 0;
-					gc_arg2 = if flags land 2 <> 0 then arg2 else 0;
-					gc_transformation = fmode;
-				};
-				if flags land 0x20 <> 0 then loop ();
-			in
-			loop ();
-			TGlyfComposite (header,(DynArray.to_list acc))
-		end else
-			failwith "Unknown Glyf"
-	in
-	Array.init maxp.maxp_num_glyphs (fun i ->
-		let len = (Int32.to_int loca.(i + 1)) - (Int32.to_int loca.(i)) in
-		if len > 0 then parse_glyf i else TGlyfNull
-	)
-
-let parse_kern_table ctx =
-	let ch = ctx.ch in
-	let version = Int32.of_int (rd16 ch) in
-	let num_tables = Int32.of_int (rd16 ch) in
-	let tables = ExtList.List.init (Int32.to_int num_tables) (fun _ ->
-		let length = Int32.of_int (rdu16 ch) in
-		let tuple_index = rdu16 ch in
-		let coverage = rdu16 ch in
-		let def = match coverage lsr 8 with
-		| 0 ->
-			let num_pairs = rdu16 ch in
-			let search_range = rdu16 ch in
-			let entry_selector = rdu16 ch in
-			let range_shift = rdu16 ch in
-			let kerning_pairs = ExtList.List.init num_pairs (fun _ ->
-				let left = rdu16 ch in
-				let right = rdu16 ch in
-				let value = rd16 ch in
-				{
-					kern_left = left;
-					kern_right = right;
-					kern_value = value;
-				}
-			) in
-			Kern0 {
-				k0_num_pairs = num_pairs;
-				k0_search_range = search_range;
-				k0_entry_selector = entry_selector;
-				k0_range_shift = range_shift;
-				k0_pairs = kerning_pairs;
-			}
-		| 2 ->
-			let row_width = rdu16 ch in
-			let left_offset_table = rdu16 ch in
-			let right_offset_table = rdu16 ch in
-			let array_offset = rdu16 ch in
-			let first_glyph = rdu16 ch in
-			let num_glyphs = rdu16 ch in
-			let offsets = ExtList.List.init num_glyphs (fun _ ->
-				rdu16 ch
-			) in
-			Kern2 {
-				k2_row_width = row_width;
-				k2_left_offset_table = left_offset_table;
-				k2_right_offset_table = right_offset_table;
-				k2_array = array_offset;
-				k2_first_glyph = first_glyph;
-				k2_num_glyphs = num_glyphs;
-				k2_offsets = offsets;
-			}
-		| i ->
-			failwith ("Unknown kerning: " ^ (string_of_int i));
-		in
-		{
-			ks_def = def;
-			ks_header = {
-				ksh_length = length;
-				ksh_coverage = coverage;
-				ksh_tuple_index = tuple_index;
-			}
-		}
-	) in
-	{
-		kern_version = version;
-		kern_num_tables = num_tables;
-		kern_subtables = tables;
-	}
-
-let parse_name_table ctx =
-	let ch = ctx.ch in
-	let format = rdu16 ch in
-	let num_records = rdu16 ch in
-	let offset = rdu16 ch in
-	let records = Array.init num_records (fun _ ->
-		let platform_id = rdu16 ch in
-		let platform_specific_id = rdu16 ch in
-		let language_id = rdu16 ch in
-		let name_id = rdu16 ch in
-		let length = rdu16 ch in
-		let offset = rdu16 ch in
-		{
-			nr_platform_id = platform_id;
-			nr_platform_specific_id = platform_specific_id;
-			nr_language_id = language_id;
-			nr_name_id = name_id;
-			nr_length = length;
-			nr_offset = offset;
-			nr_value = "";
-		}
-	) in
-	let ttf_name = ref "" in
-	(* TODO: use real utf16 conversion *)
-	let set_name n =
-		let l = ExtList.List.init (String.length n / 2) (fun i -> String.make 1 n.[i * 2 + 1]) in
-		ttf_name := String.concat "" l
-	in
-	let records = Array.map (fun r ->
-		seek_in ctx.file ((Int32.to_int ctx.entry.entry_offset) + offset + r.nr_offset);
-		r.nr_value <- nread_string ch r.nr_length;
-		if r.nr_name_id = 4 && r.nr_platform_id = 3 || r.nr_platform_id = 0 then set_name r.nr_value;
-		r
-	) records in
-	{
-		name_format = format;
-		name_num_records = num_records;
-		name_offset = offset;
-		name_records = records;
-	},!ttf_name
-
-let parse_os2_table ctx =
-	let ch = ctx.ch in
-	let version = rdu16 ch in
-	let x_avg_char_width = rd16 ch in
-	let us_weight_class = rdu16 ch in
-	let us_width_class = rdu16 ch in
-	let fs_type = rd16 ch in
-	let y_subscript_x_size = rd16 ch in
-	let y_subscript_y_size = rd16 ch in
-	let y_subscript_x_offset = rd16 ch in
-	let y_subscript_y_offset = rd16 ch in
-	let y_superscript_x_size = rd16 ch in
-	let y_superscript_y_size = rd16 ch in
-	let y_superscript_x_offset = rd16 ch in
-	let y_superscript_y_offset = rd16 ch in
-	let y_strikeout_size = rd16 ch in
-	let y_strikeout_position = rd16 ch in
-	let s_family_class = rd16 ch in
-
-	let b_family_type = read_byte ch in
-	let b_serif_style = read_byte ch in
-	let b_weight = read_byte ch in
-	let b_proportion = read_byte ch in
-	let b_contrast = read_byte ch in
-	let b_stroke_variation = read_byte ch in
-	let b_arm_style = read_byte ch in
-	let b_letterform = read_byte ch in
-	let b_midline = read_byte ch in
-	let b_x_height = read_byte ch in
-
-	let ul_unicode_range_1 = rd32r ch in
-	let ul_unicode_range_2 = rd32r ch in
-	let ul_unicode_range_3 = rd32r ch in
-	let ul_unicode_range_4 = rd32r ch in
-	let ach_vendor_id = rd32r ch in
-	let fs_selection = rd16 ch in
-	let us_first_char_index = rdu16 ch in
-	let us_last_char_index = rdu16 ch in
-	let s_typo_ascender = rd16 ch in
-	let s_typo_descender = rd16 ch in
-	let s_typo_line_gap = rd16 ch in
-	let us_win_ascent = rdu16 ch in
-	let us_win_descent = rdu16 ch in
-	{
-		os2_version = version;
-		os2_x_avg_char_width = x_avg_char_width;
-		os2_us_weight_class = us_weight_class;
-		os2_us_width_class = us_width_class;
-		os2_fs_type = fs_type;
-		os2_y_subscript_x_size = y_subscript_x_size;
-		os2_y_subscript_y_size = y_subscript_y_size;
-		os2_y_subscript_x_offset = y_subscript_x_offset;
-		os2_y_subscript_y_offset = y_subscript_y_offset;
-		os2_y_superscript_x_size = y_superscript_x_size;
-		os2_y_superscript_y_size = y_superscript_y_size;
-		os2_y_superscript_x_offset = y_superscript_x_offset;
-		os2_y_superscript_y_offset = y_superscript_y_offset;
-		os2_y_strikeout_size = y_strikeout_size;
-		os2_y_strikeout_position = y_strikeout_position;
-		os2_s_family_class = s_family_class;
-		os2_b_family_type = b_family_type;
-		os2_b_serif_style = b_serif_style;
-		os2_b_weight = b_weight;
-		os2_b_proportion = b_proportion;
-		os2_b_contrast = b_contrast;
-		os2_b_stroke_variation = b_stroke_variation;
-		os2_b_arm_style = b_arm_style;
-		os2_b_letterform = b_letterform;
-		os2_b_midline = b_midline;
-		os2_b_x_height = b_x_height;
-		os2_ul_unicode_range_1 = ul_unicode_range_1;
-		os2_ul_unicode_range_2 = ul_unicode_range_2;
-		os2_ul_unicode_range_3 = ul_unicode_range_3;
-		os2_ul_unicode_range_4 = ul_unicode_range_4;
-		os2_ach_vendor_id = ach_vendor_id;
-		os2_fs_selection = fs_selection;
-		os2_us_first_char_index = us_first_char_index;
-		os2_us_last_char_index = us_last_char_index;
-		os2_s_typo_ascender = s_typo_ascender;
-		os2_s_typo_descender = s_typo_descender;
-		os2_s_typo_line_gap = s_typo_line_gap;
-		os2_us_win_ascent = us_win_ascent;
-		os2_us_win_descent = us_win_descent;
-	}
-
-let parse file : ttf =
-	let ctx = {
-		file = file;
-		ch = input_channel file;
-		entry = {
-			entry_table_name = "";
-			entry_offset = Int32.of_int 0;
-			entry_length = Int32.of_int 0;
-			entry_checksum = Int32.of_int 0;
-		}
-	} in
-	let header = parse_header ctx in
-	let directory = parse_directory ctx header in
-	let parse_table entry f =
-		seek_in file (Int32.to_int entry.entry_offset);
-		ctx.entry <- entry;
-		f ctx
-	in
-	let parse_req_table name f =
-		try
-			let entry = Hashtbl.find directory name in
-			parse_table entry f
-		with Not_found ->
-			failwith (Printf.sprintf "Required table %s could not be found" name)
-	in
-	let parse_opt_table name f =
-		try
-			let entry = Hashtbl.find directory name in
-			Some (parse_table entry f)
-		with Not_found ->
-			None
-	in
-	let head = parse_req_table "head" parse_head_table in
-	let hhea = parse_req_table "hhea" parse_hhea_table in
-	let maxp = parse_req_table "maxp" parse_maxp_table in
-	let loca = parse_req_table "loca" (parse_loca_table head maxp) in
-	let hmtx = parse_req_table "hmtx" (parse_hmtx_table maxp hhea) in
-	let cmap = parse_req_table "cmap" (parse_cmap_table) in
-	let glyfs = parse_req_table "glyf" (parse_glyf_table maxp loca cmap hmtx) in
-	let kern = parse_opt_table "kern" (parse_kern_table) in
-	let name,ttf_name = parse_req_table "name" (parse_name_table) in
-	let os2 = parse_req_table "OS/2" (parse_os2_table) in
-	{
-		ttf_header = header;
-		ttf_font_name = ttf_name;
-		ttf_directory = directory;
-		ttf_head = head;
-		ttf_hhea = hhea;
-		ttf_maxp = maxp;
-		ttf_loca = loca;
-		ttf_hmtx = hmtx;
-		ttf_cmap = cmap;
-		ttf_glyfs = glyfs;
-		ttf_name = name;
-		ttf_os2 = os2;
-		ttf_kern = kern;
-	}

libs/ttflib/tTFSwfWriter.ml

@@ -1,211 +0,0 @@
-(*
- * Copyright (C)2005-2014 Haxe Foundation
- *
- * Permission is hereby granted, free of charge, to any person obtaining a
- * copy of this software and associated documentation files (the "Software"),
- * to deal in the Software without restriction, including without limitation
- * the rights to use, copy, modify, merge, publish, distribute, sublicense,
- * and/or sell copies of the Software, and to permit persons to whom the
- * Software is furnished to do so, subject to the following conditions:
- *
- * The above copyright notice and this permission notice shall be included in
- * all copies or substantial portions of the Software.
- *
- * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
- * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
- * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
- * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
- * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
- * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
- * DEALINGS IN THE SOFTWARE.
- *)
-
-open TTFData
-open Swf
-
-let num_bits x =
-	if x = 0 then
-		0
-	else
-		let rec loop n v =
-			if v = 0 then n else loop (n + 1) (v lsr 1)
-		in
-		loop 1 (abs x)
-
-let round x = int_of_float (floor (x +. 0.5))
-
-let to_twips v = round (v *. 20.)
-
-type ctx = {
-	ttf : ttf;
-}
-
-let begin_fill =
-	SRStyleChange {
-		scsr_move = None;
-		scsr_fs0 = Some(1);
-		scsr_fs1 = None;
-		scsr_ls = None;
-		scsr_new_styles = None;
-	}
-
-let end_fill =
-	SRStyleChange {
-		scsr_move = None;
-		scsr_fs0 = None;
-		scsr_fs1 = None;
-		scsr_ls = None;
-		scsr_new_styles = None;
-	}
-
-let align_bits x nbits = x land ((1 lsl nbits ) - 1)
-
-let move_to ctx x y =
-	let x = to_twips x in
-	let y = to_twips y in
-	let nbits = max (num_bits x) (num_bits y) in
-	SRStyleChange {
-		scsr_move = Some (nbits, align_bits x nbits, align_bits y nbits);
-		scsr_fs0 = Some(1);
-		scsr_fs1 = None;
-		scsr_ls = None;
-		scsr_new_styles = None;
-	}
-
-let line_to ctx x y =
-	let x = to_twips x in
-	let y = to_twips y in
-	if x = 0 && y = 0 then raise Exit;
-	let nbits = max (num_bits x) (num_bits y) in
-	SRStraightEdge {
-		sser_nbits = nbits;
-		sser_line = (if x = 0 then None else Some(align_bits x nbits)), (if y = 0 then None else Some(align_bits y nbits));
-	}
-
-let curve_to ctx cx cy ax ay =
-	let cx = to_twips cx in
-	let cy = to_twips cy in
-	let ax = to_twips ax in
-	let ay = to_twips ay in
-	let nbits = max (max (num_bits cx) (num_bits cy)) (max (num_bits ax) (num_bits ay)) in
-	SRCurvedEdge {
-		scer_nbits = nbits;
-		scer_cx = align_bits cx nbits;
-		scer_cy = align_bits cy nbits;
-		scer_ax = align_bits ax nbits;
-		scer_ay = align_bits ay nbits;
-	}
-
-open TTFTools
-
-let write_paths ctx paths =
-	let scale = 1024. /. (float_of_int ctx.ttf.ttf_head.hd_units_per_em) in
-	let srl = DynArray.create () in
-	List.iter (fun path ->
-		try
-			DynArray.add srl (match path.gp_type with
-			| 0 -> move_to ctx (path.gp_x *. scale) ((-1.) *. path.gp_y *. scale);
-			| 1 -> line_to ctx (path.gp_x *. scale) ((-1.) *. path.gp_y *. scale);
-			| 2 -> curve_to ctx (path.gp_cx *. scale) ((-1.) *. path.gp_cy *. scale) (path.gp_x *. scale) ((-1.) *. path.gp_y *. scale);
-			| _ -> assert false)
-		with Exit ->
-			()
-	) paths;
-	DynArray.add srl (end_fill);
-	{
-		srs_nfbits = 1;
-		srs_nlbits = 0;
-		srs_records = DynArray.to_list srl;
-	}
-
-let rec write_glyph ctx key glyf =
-	{
-		font_char_code = key;
-		font_shape = write_paths ctx (TTFTools.build_glyph_paths ctx.ttf true glyf);
-	}
-
-let write_font_layout ctx lut =
-	let scale = 1024. /. (float_of_int ctx.ttf.ttf_head.hd_units_per_em) in
-	let hmtx = Hashtbl.fold (fun k v acc -> (k,ctx.ttf.ttf_hmtx.(v)) :: acc) lut [] in
-	let hmtx = List.stable_sort (fun a b -> compare (fst a) (fst b)) hmtx in
-	let hmtx = List.map (fun (k,g) -> g) hmtx in
-	{
-			font_ascent = round((float_of_int ctx.ttf.ttf_os2.os2_us_win_ascent) *. scale *. 20.);
-			font_descent = round((float_of_int ctx.ttf.ttf_os2.os2_us_win_descent) *. scale *. 20.);
-			font_leading = round(((float_of_int(ctx.ttf.ttf_os2.os2_us_win_ascent + ctx.ttf.ttf_os2.os2_us_win_descent - ctx.ttf.ttf_head.hd_units_per_em)) *. scale) *. 20.);
-			font_glyphs_layout = Array.of_list( ExtList.List.mapi (fun i h ->
-			{
-				font_advance = round((float_of_int h.advance_width) *. scale *. 20.);
-				font_bounds = {rect_nbits=0; left=0; right=0; top=0; bottom=0};
-			}) hmtx );
-			font_kerning = [];
-	}
-
-let bi v = if v then 1 else 0
-
-let int_from_langcode lc =
-	match lc with
-	| LCNone -> 0
-	| LCLatin -> 1
-	| LCJapanese -> 2
-	| LCKorean -> 3
-	| LCSimplifiedChinese -> 4
-	| LCTraditionalChinese -> 5
-
-let write_font2 ch b f2 =
-	IO.write_bits b 1 (bi true);
-	IO.write_bits b 1 (bi f2.font_shift_jis);
-	IO.write_bits b 1 (bi f2.font_is_small);
-	IO.write_bits b 1 (bi f2.font_is_ansi);
-	IO.write_bits b 1 (bi f2.font_wide_offsets);
-	IO.write_bits b 1 (bi f2.font_wide_codes);
-	IO.write_bits b 1 (bi f2.font_is_italic);
-	IO.write_bits b 1 (bi f2.font_is_bold);
-	IO.write_byte ch (int_from_langcode f2.font_language);
-	IO.write_byte ch ((String.length f2.font_name) + 1);
-	IO.nwrite_string ch f2.font_name;
-	IO.write_byte ch 0;
-	IO.write_ui16 ch (Array.length f2.font_glyphs);
-	let glyph_offset = ref (((Array.length f2.font_glyphs) * 4)+4) in
-	Array.iter (fun g ->
-		IO.write_i32 ch !glyph_offset;
-		glyph_offset := !glyph_offset + SwfParser.font_shape_records_length g.font_shape;
-	)f2.font_glyphs;
-	IO.write_i32 ch !glyph_offset;
-	Array.iter (fun g -> SwfParser.write_shape_without_style ch g.font_shape;) f2.font_glyphs;
-	Array.iter (fun g -> IO.write_ui16 ch g.font_char_code; )f2.font_glyphs;
-	IO.write_i16 ch f2.font_layout.font_ascent;
-	IO.write_i16 ch f2.font_layout.font_descent;
-	IO.write_i16 ch f2.font_layout.font_leading;
-	Array.iter (fun g ->
-		let fa = ref g.font_advance in
-		if (!fa) <  -32767 then fa := -32768;(* fix or check *)
-		if (!fa) > 32766 then fa := 32767;
-		IO.write_i16 ch !fa;) f2.font_layout.font_glyphs_layout;
-	Array.iter (fun g -> SwfParser.write_rect ch g.font_bounds;) f2.font_layout.font_glyphs_layout;
-	IO.write_ui16 ch 0 (* TODO: optional FontKerningTable *)
-
-let to_swf ttf config =
-	let ctx = {
-		ttf = ttf;
-	} in
-	let lut = TTFTools.build_lut ttf config.ttfc_range_str in
-	let glyfs = Hashtbl.fold (fun k v acc -> (k,ctx.ttf.ttf_glyfs.(v)) :: acc) lut [] in
-	let glyfs = List.stable_sort (fun a b -> compare (fst a) (fst b)) glyfs in
-	let glyfs = List.map (fun (k,g) -> write_glyph ctx k g) glyfs in
-	let glyfs_font_layout = write_font_layout ctx lut in
-	let glyfs = Array.of_list glyfs in
-	{
-		font_shift_jis = false;
-		font_is_small = false;
-		font_is_ansi = false;
-		font_wide_offsets = true;
-		font_wide_codes = true;
-		font_is_italic = config.ttfc_font_posture = TFPItalic;
-		font_is_bold = config.ttfc_font_weight = TFWBold;
-		font_language = LCNone;
-		font_name = (match config.ttfc_font_name with Some s -> s | None -> ttf.ttf_font_name);
-		font_glyphs = glyfs;
-		font_layout = glyfs_font_layout;
-	}
-;;

libs/ttflib/tTFTools.ml

@@ -1,275 +0,0 @@
-(*
- * Copyright (C)2005-2014 Haxe Foundation
- *
- * Permission is hereby granted, free of charge, to any person obtaining a
- * copy of this software and associated documentation files (the "Software"),
- * to deal in the Software without restriction, including without limitation
- * the rights to use, copy, modify, merge, publish, distribute, sublicense,
- * and/or sell copies of the Software, and to permit persons to whom the
- * Software is furnished to do so, subject to the following conditions:
- *
- * The above copyright notice and this permission notice shall be included in
- * all copies or substantial portions of the Software.
- *
- * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
- * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
- * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
- * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
- * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
- * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
- * DEALINGS IN THE SOFTWARE.
- *)
-open Extlib_leftovers
-open TTFData
-
-type glyf_transformation_matrix = {
-	mutable a : float;
-	mutable b : float;
-	mutable c : float;
-	mutable d : float;
-	mutable tx : float;
-	mutable ty : float;
-}
-
-type glyf_path = {
-	gp_type : int;
-	gp_x : float;
-	gp_y : float;
-	gp_cx : float;
-	gp_cy : float;
-}
-
-type simple_point = {
-	x : float;
-	y : float;
-}
-
-let mk_path t x y cx cy = {
-	gp_type = t;
-	gp_x = x;
-	gp_y = y;
-	gp_cx = cx;
-	gp_cy = cy;
-}
-
-let identity () = {
-	a = 1.0;
-	b = 0.0;
-	c = 0.0;
-	d = 1.0;
-	tx = 0.0;
-	ty = 0.0;
-}
-
-let multiply m x y =
-	x *. m.a +. y *. m.b +. m.tx,
-	x *. m.c +. y *. m.d +. m.ty
-
-(* TODO: check if this can be done in the parser directly *)
-let matrix_from_composite gc =
-	let a,b,c,d = match gc.gc_transformation with
-		| NoScale -> 1.0,0.0,0.0,1.0
-		| Scale f -> f,0.0,0.0,f
-		| ScaleXY(fx,fy) -> fx,0.0,0.0,fy
-		| ScaleMatrix (a,b,c,d) -> a,b,c,d
-	in
-	let arg1 = float_of_int gc.gc_arg1 in
-	let arg2 = float_of_int gc.gc_arg2 in
-	{
-		a = a;
-		b = b;
-		c = c;
-		d = d;
-		(* TODO: point offsets *)
-		tx = arg1 *. a +. arg2 *. b;
-		ty = arg1 *. c +. arg2 *. d;
-	}
-
-let relative_matrix m = {m with tx = 0.0; ty = 0.0}
-
-let make_coords relative mo g = match mo with
-	| None ->
-		Array.init (Array.length g.gs_x_coordinates) (fun i -> float_of_int g.gs_x_coordinates.(i),float_of_int g.gs_y_coordinates.(i))
-	| Some m ->
-		let m = if relative then relative_matrix m else m in
-		Array.init (Array.length g.gs_x_coordinates) (fun i ->
-			let x,y = float_of_int g.gs_x_coordinates.(i),float_of_int g.gs_y_coordinates.(i) in
-			multiply m x y
-		)
-
-let build_paths relative mo g =
-	let len = Array.length g.gs_x_coordinates in
-	let current_end = ref 0 in
-	let end_pts = Array.init len (fun i ->
-		if g.gs_end_pts_of_contours.(!current_end) = i then begin
-			incr current_end;
-			true
-		end else
-			false
-	) in
-	let is_on i = g.gs_flags.(i) land 0x01 <> 0 in
-	let is_end i = end_pts.(i) in
-	let arr = DynArray.create () in
-	let tx,ty = match mo with None -> 0.0,0.0 | Some m -> m.tx,m.ty in
-	let last_added = ref {
-		x = 0.0;
-		y = 0.0;
-	} in
-	let add_rel t x y cx cy =
-		let p = match t with
-			| 0 ->
-				mk_path t (x +. tx) (y +. ty) cx cy
-			| 1 ->
-				mk_path t (x -. !last_added.x) (y -. !last_added.y) cx cy
-			| 2 ->
-				mk_path t (x -. cx) (y -. cy) (cx -. !last_added.x) (cy -. !last_added.y)
-			| _ ->
-				assert false
-		in
-		last_added := { x = x; y = y; };
-		DynArray.add arr p
-	in
-	let add_abs t x y cx cy = DynArray.add arr (mk_path t x y cx cy) in
-	let add = if relative then add_rel else add_abs in
-	let coords = make_coords relative mo g in
-
-	let left = ref [] in
-	let right = ref [] in
-	let new_contour = ref true in
-	let p = ref { x = 0.0; y = 0.0 } in
-	for i = 0 to len - 1 do
-		p := {
-			x = !p.x +. fst coords.(i);
-			y = !p.y +. snd coords.(i);
-		};
-		let p = !p in
-		let is_on = is_on i in
-		let is_end = is_end i in
-		let rec flush pl = match pl with
-			| c :: a :: [] -> add 2 a.x a.y c.x c.y
-			| a :: [] -> add 1 a.x a.y 0.0 0.0
-			| c1 :: c2 :: pl ->
-				add 2 (c1.x +. (c2.x -. c1.x) /. 2.0) (c1.y +. (c2.y -. c1.y) /. 2.0) c1.x c1.y;
-				flush (c2 :: pl)
-			| _ ->
-				Printf.printf "Fail, len: %i\n" (List.length pl);
-		in
-		if !new_contour then begin
-			if is_on then begin
-				new_contour := false;
-				add 0 p.x p.y 0.0 0.0;
-			end;
-			left := p :: !left
-		end else if is_on || is_end then begin
-			right := p :: !right;
-			if is_on then begin
-				flush (List.rev !right);
-				right := []
-			end;
-			if is_end then begin
-				new_contour := true;
-				flush ((List.rev !right) @ (List.rev !left));
-				left := [];
-				right := [];
-			end
-		end else
-			right := p :: !right
-	done;
-	DynArray.to_list arr
-
-let rec build_glyph_paths ttf relative ?(transformation=None) glyf =
-	match glyf with
-	| TGlyfSimple (h,g) ->
-		build_paths relative transformation g
-	| TGlyfComposite (h,gl) ->
-		List.concat (List.map (fun g ->
-			let t = Some (matrix_from_composite g) in
-			build_glyph_paths ttf relative ~transformation:t (ttf.ttf_glyfs.(g.gc_glyf_index))
-		) gl)
-	| TGlyfNull ->
-		[]
-
-let map_char_code cc c4 =
-	let index = ref 0 in
-	let seg_count = c4.c4_seg_count_x2 / 2 in
-	if cc >= 0xFFFF then 0 else begin
-		for i = 0 to seg_count - 1 do
-			if c4.c4_end_code.(i) >= cc && c4.c4_start_code.(i) <= cc then begin
-				if c4.c4_id_range_offset.(i) > 0 then
-					let v = c4.c4_id_range_offset.(i)/2 + cc - c4.c4_start_code.(i) - seg_count + i in
-					index := c4.c4_glyph_index_array.(v)
-				else
-					index := (c4.c4_id_delta.(i) + cc) mod 65536
-			end
-		done;
-		!index
-	end
-
-let parse_range_str str =
-	let last = ref (Char.code '\\') in
-	let range = ref false in
-	let lut = Hashtbl.create 0 in
-	UTF8.iter (fun code ->
-		let code = UCharExt.code code in
-		if code = Char.code '-' && !last <> Char.code '\\' then
-			range := true
-		else if !range then begin
-			range := false;
-			for i = !last to code do
-				Hashtbl.replace lut i true;
-			done;
-		end else begin
-			Hashtbl.replace lut code true;
-			last := code;
-		end
-	) str;
-	if !range then Hashtbl.replace lut (Char.code '-') true;
-	lut
-
-let build_lut ttf range_str =
-	let lut = Hashtbl.create 0 in
-	Hashtbl.add lut 0 0;
-	Hashtbl.add lut 1 1;
-	Hashtbl.add lut 2 2;
-	let add_character = if range_str = "" then
-			fun k v -> Hashtbl.replace lut k v
-		else begin
-			let range = parse_range_str range_str in
-			fun k v -> if Hashtbl.mem range k then Hashtbl.replace lut k v
-		end
-	in
-	let make_cmap4_map c4 =
-		let seg_count = c4.c4_seg_count_x2 / 2 in
-		for i = 0 to seg_count - 1 do
-			for j = c4.c4_start_code.(i) to c4.c4_end_code.(i) do
-				let index = map_char_code j c4 in
-				add_character j index;
-			done;
-		done
-	in
-(*  	let make_cmap12_map c12 =
-		List.iter (fun group ->
-			let rec loop cc gi =
-				add_character cc gi;
-				if cc < (Int32.to_int group.c12g_end_char_code) then loop (cc + 1) (gi + 1)
-			in
-			loop (Int32.to_int group.c12g_start_char_code) (Int32.to_int group.c12g_start_glyph_code)
-		) c12.c12_groups
-	in *)
-	List.iter (fun st -> match st.cs_def with
-		| Cmap0 c0 ->
-			Array.iteri (fun i c -> add_character i (int_of_char c)) c0.c0_glyph_index_array;
-		| Cmap4 c4 ->
-			make_cmap4_map c4;
-		| Cmap12 c12 ->
-			(*
-				TODO: this causes an exception with some fonts:
-				Fatal error: exception IO.Overflow("write_ui16")
-			*)
-			(* make_cmap12_map ctx lut c12; *)
-			()
-		| _ ->
-			(* TODO *)
-			()
-	) ttf.ttf_cmap.cmap_subtables;
-	lut

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",
@@ -319,6 +275,114 @@
 		"doc": "Include additional information for hxcpp-debugger.",
 		"platforms": ["cpp"]
 	},
+	{
+		"name": "HxcppGcMoving",
+		"define": "HXCPP-GC-MOVING",
+		"doc": "Allow garbage collector to move memory to reduce fragmentation",
+		"platforms": ["cpp"]
+	},
+	{
+		"name": "HxcppGcSummary",
+		"define": "HXCPP-GC-SUMMARY",
+		"doc": "Print small profiling summary at end of program",
+		"platforms": ["cpp"]
+	},
+	{
+		"name": "HxcppGcDynamicSize",
+		"define": "HXCPP-GC-DYNAMIC-SIZE",
+		"doc": "Monitor GC times and expand memory working space if required",
+		"platforms": ["cpp"]
+	},
+	{
+		"name": "HxcppGcBigBlocks",
+		"define": "HXCPP-GC-BIG-BLOCKS",
+		"doc": "Allow working memory greater than 1 Gig",
+		"platforms": ["cpp"]
+	},
+	{
+		"name": "HxcppGcDebugLevel",
+		"define": "HXCPP-GC-DEBUG-LEVEL",
+		"doc": "Number 1-4 indicating additional debugging in GC",
+		"platforms": ["cpp"]
+	},
+	{
+		"name": "HxcppDebugLink",
+		"define": "HXCPP-DEBUG-LINK",
+		"doc": "Add symbols to final binary, even in release mode.",
+		"platforms": ["cpp"]
+	},
+	{
+		"name": "HxcppStackTrace",
+		"define": "HXCPP-STACK-TRACE",
+		"doc": "Have valid function-level stack traces, even in release mode.",
+		"platforms": ["cpp"]
+	},
+	{
+		"name": "HxcppStackLine",
+		"define": "HXCPP-STACK-LINE",
+		"doc": "Include line information in stack traces, even in release mode.",
+		"platforms": ["cpp"]
+	},
+	{
+		"name": "HxcppCheckPointer",
+		"define": "HXCPP-CHECK-POINTER",
+		"doc": "Add null-pointer checks, even in release mode.",
+		"platforms": ["cpp"]
+	},
+	{
+		"name": "HxcppProfiler",
+		"define": "HXCPP-PROFILER",
+		"doc": "Add profiler support",
+		"platforms": ["cpp"]
+	},
+	{
+		"name": "HxcppTelemetry",
+		"define": "HXCPP-TELEMETRY",
+		"doc": "Add telemetry support",
+		"platforms": ["cpp"]
+	},
+	{
+		"name": "HxcppCpp11",
+		"define": "HXCPP-CPP11",
+		"doc": "Use C++11 features and link libraries",
+		"platforms": ["cpp"]
+	},
+	{
+		"name": "HxcppVerbose",
+		"define": "HXCPP-VERBOSE",
+		"doc": "Print extra output from build tool.",
+		"platforms": ["cpp"]
+	},
+	{
+		"name": "HxcppTimes",
+		"define": "HXCPP-TIMES",
+		"doc": "Show some basic profiling information",
+		"platforms": ["cpp"]
+	},
+	{
+		"name": "HxcppM32",
+		"define": "HXCPP-M32",
+		"doc": "Force 32-bit compile for current desktop",
+		"platforms": ["cpp"]
+	},
+	{
+		"name": "HxcppM64",
+		"define": "HXCPP-M64",
+		"doc": "Force 64-bit compile for current desktop",
+		"platforms": ["cpp"]
+	},
+	{
+		"name": "HxcppArm64",
+		"define": "HXCPP-ARM64",
+		"doc": "Compile arm-based devices for 64 bits",
+		"platforms": ["cpp"]
+	},
+	{
+		"name": "HxcppLinuxArm64",
+		"define": "HXCPP-LINUX-ARM64",
+		"doc": "Run on a linux ARM64 device",
+		"platforms": ["cpp"]
+	},
 	{
 		"name": "HxcppSmartStings",
 		"define": "hxcpp-smart-strings",
@@ -336,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",
@@ -394,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",
@@ -455,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",
@@ -507,7 +524,7 @@
 		"name": "NoCompilation",
 		"define": "no-compilation",
 		"doc": "Disable final compilation.",
-		"platforms": ["cs", "java", "cpp", "hl"]
+		"platforms": ["cpp", "hl"]
 	},
 	{
 		"name": "NoDebug",
@@ -543,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",
@@ -608,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",
@@ -655,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",
@@ -745,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",
@@ -790,6 +789,11 @@
 		"define": "message.no-color",
 		"doc": "Disable ANSI color codes in message reporting."
 	},
+	{
+		"name": "MessageAbsolutePositions",
+		"define": "message.absolute-positions",
+		"doc": "Use absolute character positions instead of line/columns for message reporting."
+	},
 	{
 		"name": "MessageLogFile",
 		"define": "message.log-file",

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,20 +223,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",
-		"doc": "Automatically added by `--net-lib` on events. Has no effect on types compiled by Haxe.",
-		"platforms": ["cs"],
-		"targets": ["TClassField"]
-	},
 	{
 		"name": "Exhaustive",
 		"metadata": ":exhaustive",
@@ -426,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",
@@ -479,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",
@@ -518,6 +424,12 @@
 		"platforms": ["hl"],
 		"targets": ["TClass", "TClassField"]
 	},
+	{
+		"name": "HxbId",
+		"metadata": ":hxb.id",
+		"doc": "Internally used by hxb",
+		"internal": true
+	},
 	{
 		"name": "HxCompletion",
 		"metadata": ":hx.completion",
@@ -528,7 +440,6 @@
 		"name": "HxGen",
 		"metadata": ":hxGen",
 		"doc": "Annotates that an extern class was generated by Haxe.",
-		"platforms": ["java", "cs"],
 		"targets": ["TClass", "TEnum"]
 	},
 	{
@@ -597,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",
@@ -611,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"]
 	},
 	{
@@ -687,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
 	},
@@ -714,12 +601,6 @@
 		"metadata": ":macro",
 		"doc": "(deprecated)"
 	},
-	{
-		"name": "MaybeUsed",
-		"metadata": ":maybeUsed",
-		"doc": "Internally used by DCE to mark fields that might be kept.",
-		"internal": true
-	},
 	{
 		"name": "MergeBlock",
 		"metadata": ":mergeBlock",
@@ -753,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",
@@ -983,7 +849,7 @@
 		"name": "Private",
 		"metadata": ":private",
 		"doc": "Marks a class field as being private.",
-		"platforms": ["cs"],
+		"platforms": ["jvm"],
 		"targets": ["TClassField"]
 	},
 	{
@@ -996,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"]
 	},
 	{
@@ -1012,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",
@@ -1094,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",
@@ -1145,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"]
 	},
 	{
@@ -1168,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",
@@ -1188,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",
@@ -1216,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",
@@ -1239,7 +1054,7 @@
 		"name": "Volatile",
 		"metadata": ":volatile",
 		"doc": "",
-		"platforms": ["java", "cs"]
+		"platforms": ["jvm"]
 	},
 	{
 		"name": "UnifyMinDynamic",
@@ -1253,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",

src-json/warning.json

@@ -98,6 +98,11 @@
 		"doc": "A type path is being used that is supposed to be reserved on the current target",
 		"parent": "WTyper"
 	},
+	{
+		"name": "WInlineOptimizedField",
+		"doc": "A cached field which was optimized might lead to different output when inlined",
+		"parent": "WTyper"
+	},
 	{
 		"name": "WPatternMatcher",
 		"doc": "Warnings related to the pattern matcher",
@@ -112,6 +117,14 @@
 		"name": "WConstructorInliningCancelled",
 		"doc": "Constructor call could not be inlined because a field is uninitialized",
 		"parent": "WTyper"
+	},
+	{
+		"name": "WHxb",
+		"doc": "Hxb (either --hxb output or haxe compiler cache) related warnings"
+	},
+	{
+		"name": "WUnboundTypeParameter",
+		"doc": "Hxb (either --hxb output or haxe compiler cache) failed to link a type parameter to an actual type",
+		"parent": "WHxb"
 	}
-
-]
+]

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"

src/codegen/codegen.ml

@@ -65,15 +65,6 @@ let add_property_field com c =
 		c.cl_statics <- PMap.add cf.cf_name cf c.cl_statics;
 		c.cl_ordered_statics <- cf :: c.cl_ordered_statics
 
-let escape_res_name name allowed =
-	ExtString.String.replace_chars (fun chr ->
-		if (chr >= 'a' && chr <= 'z') || (chr >= 'A' && chr <= 'Z') || (chr >= '0' && chr <= '9') || chr = '_' || chr = '.' then
-			Char.escaped chr
-		else if List.mem chr allowed then
-			Char.escaped chr
-		else
-			"-x" ^ (string_of_int (Char.code chr))) name
-
 (* -------------------------------------------------------------------------- *)
 (* FIX OVERRIDES *)
 
@@ -122,8 +113,13 @@ let fix_override com c f fd =
 					(* Flash generates type parameters with a single constraint as that constraint type, so we
 					   have to detect this case and change the variable (issue #2712). *)
 					begin match follow v.v_type with
-						| TInst({cl_kind = KTypeParameter [tc]} as cp,_) when com.platform = Flash ->
-							if List.exists (fun tp -> tp.ttp_name = (snd cp.cl_path)) c.cl_params then raise (Unify_error [])
+						| TInst({cl_kind = KTypeParameter ttp} as cp,_) when com.platform = Flash ->
+							begin match get_constraints ttp with
+							| [tc] ->
+								if List.exists (fun tp -> tp.ttp_name = (snd cp.cl_path)) c.cl_params then raise (Unify_error [])
+							| _ ->
+								()
+							end
 						| _ ->
 							()
 					end;
@@ -235,11 +231,16 @@ module Dump = struct
 		let buf,close = create_dumpfile [] ((dump_path com) :: (platform_name_macro com) :: fst path @ [snd path]) in
 		buf,close
 
-	let dump_types com s_expr =
+	let dump_types com pretty =
 		let s_type = s_type (Type.print_context()) in
+		let s_expr,s_type_param = if not pretty then
+			(Type.s_expr_ast (not (Common.defined com Define.DumpIgnoreVarIds)) "\t"),(Printer.s_type_param "")
+		else
+			(Type.s_expr_pretty false "\t" true),(s_type_param s_type)
+		in
 		let params tl = match tl with
 			| [] -> ""
-			| l -> Printf.sprintf "<%s>" (String.concat ", " (List.map Printer.s_type_param l))
+			| l -> Printf.sprintf "<%s>" (String.concat ", " (List.map s_type_param l))
 		in
 		List.iter (fun mt ->
 			let path = Type.t_path mt in
@@ -306,7 +307,7 @@ module Dump = struct
 				| Some f -> print_field false f);
 				List.iter (print_field false) c.cl_ordered_fields;
 				List.iter (print_field true) c.cl_ordered_statics;
-				(match c.cl_init with
+				(match TClass.get_cl_init c with
 				| None -> ()
 				| Some e ->
 					print "\n\tstatic function __init__() ";
@@ -371,10 +372,10 @@ module Dump = struct
 
 	let dump_types com =
 		match Common.defined_value_safe com Define.Dump with
-			| "pretty" -> dump_types com (Type.s_expr_pretty false "\t" true)
+			| "pretty" -> dump_types com true
 			| "record" -> dump_record com
 			| "position" -> dump_position com
-			| _ -> dump_types com (Type.s_expr_ast (not (Common.defined com Define.DumpIgnoreVarIds)) "\t")
+			| _ -> dump_types com false
 
 	let dump_dependencies ?(target_override=None) com =
 		let target_name = match target_override with
@@ -387,8 +388,8 @@ module Dump = struct
 		let dep = Hashtbl.create 0 in
 		List.iter (fun m ->
 			print "%s:\n" (Path.UniqueKey.lazy_path m.m_extra.m_file);
-			PMap.iter (fun _ (sign,mpath) ->
-				let m2 = (com.cs#get_context sign)#find_module mpath in
+			PMap.iter (fun _ mdep ->
+				let m2 = com.module_lut#find mdep.md_path in
 				let file = Path.UniqueKey.lazy_path m2.m_extra.m_file in
 				print "\t%s\n" file;
 				let l = try Hashtbl.find dep file with Not_found -> [] in
@@ -414,26 +415,11 @@ end
 *)
 let default_cast ?(vtmp="$t") com e texpr t p =
 	let api = com.basic in
-	let mk_texpr = function
-		| TClassDecl c -> mk_anon (ref (ClassStatics c))
-		| TEnumDecl e -> mk_anon (ref (EnumStatics e))
-		| TAbstractDecl a -> mk_anon (ref (AbstractStatics a))
-		| TTypeDecl _ -> die "" __LOC__
-	in
 	let vtmp = alloc_var VGenerated vtmp e.etype e.epos in
 	let var = mk (TVar (vtmp,Some e)) api.tvoid p in
 	let vexpr = mk (TLocal vtmp) e.etype p in
-	let texpr = mk (TTypeExpr texpr) (mk_texpr texpr) p in
-	let std = (try List.find (fun t -> t_path t = ([],"Std")) com.types with Not_found -> die "" __LOC__) in
-	let fis = (try
-			let c = (match std with TClassDecl c -> c | _ -> die "" __LOC__) in
-			FStatic (c, PMap.find "isOfType" c.cl_statics)
-		with Not_found ->
-			die "" __LOC__
-	) in
-	let std = mk (TTypeExpr std) (mk_texpr std) p in
-	let is = mk (TField (std,fis)) (tfun [t_dynamic;t_dynamic] api.tbool) p in
-	let is = mk (TCall (is,[vexpr;texpr])) api.tbool p in
+	let texpr = Texpr.Builder.make_typeexpr texpr p in
+	let is = Texpr.Builder.resolve_and_make_static_call com.std "isOfType" [vexpr;texpr] p in
 	let enull = Texpr.Builder.make_null vexpr.etype p in
 	let eop = Texpr.Builder.binop OpEq vexpr enull api.tbool p in
 	let echeck = Texpr.Builder.binop OpBoolOr is eop api.tbool p in
@@ -504,14 +490,9 @@ let map_source_header com f =
 
 (* Static extensions for classes *)
 module ExtClass = struct
-
-	let add_cl_init c e = match c.cl_init with
-			| None -> c.cl_init <- Some e
-			| Some e' -> c.cl_init <- Some (concat e' e)
-
 	let add_static_init c cf e p =
 		let ethis = Texpr.Builder.make_static_this c p in
 		let ef1 = mk (TField(ethis,FStatic(c,cf))) cf.cf_type p in
 		let e_assign = mk (TBinop(OpAssign,ef1,e)) e.etype p in
-		add_cl_init c e_assign
+		TClass.add_cl_init c e_assign
 end

src/codegen/dotnet.ml

@@ -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

src/codegen/gencommon/abstractImplementationFix.ml

@@ -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

src/codegen/gencommon/arrayDeclSynf.ml

@@ -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

src/codegen/gencommon/arraySpliceOptimization.ml

@@ -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

src/codegen/gencommon/castDetect.ml

@@ -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 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 tl },_), t2 when List.exists (fun t -> unifies t t2) tl ->
-		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>():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 <Dynamic> 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

src/codegen/gencommon/classInstance.ml

@@ -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

src/codegen/gencommon/closuresToClass.ml

@@ -1,1183 +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 -> match follow tp.ttp_type with
-					| TInst(c,_) -> c
-					| _ -> die "" __LOC__) 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 -> mk_type_param (snd cl.cl_path) (TInst(cl, [])) None) 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 same_cl t1 t2 = match follow t1, follow t2 with
-				| TInst(c,_), TInst(c2,_) -> c == c2
-				| _ -> false
-			in
-			let passoc = List.map2 (fun tp m -> tp.ttp_type,m) types monos in
-			let cltparams = List.map (fun tp ->
-				try
-					snd (List.find (fun (t2,_) -> same_cl tp.ttp_type 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;;

src/codegen/gencommon/dynamicFieldAccess.ml

@@ -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(tl) }, _) ->
-			List.exists (fun t -> not (is_dynamic { fexpr with etype = t } f)) tl
-		| _ -> 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(tl) } 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)) tl) 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

src/codegen/gencommon/dynamicOperators.ml

@@ -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

src/codegen/gencommon/enumToClass.ml

@@ -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 (fun tp -> {tp with ttp_type=TInst (map_param (get_cl_t tp.ttp_type), [])}) 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 (fun tp -> {tp with ttp_type = TInst (map_param (get_cl_t tp.ttp_type), [])}) 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

src/codegen/gencommon/enumToClass2.ml

@@ -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;

src/codegen/gencommon/expressionUnwrap.ml

@@ -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

src/codegen/gencommon/filterClosures.ml

@@ -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

src/codegen/gencommon/fixOverrides.ml

@@ -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

src/codegen/gencommon/gencommon.ml

@@ -1,1364 +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> -> 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.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.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 e ->
-			c.cl_init <- Some (List.fold_left (fun e f -> f e) e filters));
-	| 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 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 map_param cl =
-	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;
-	ret
-
-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
-

src/codegen/gencommon/hardNullableSynf.ml

@@ -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<T> types for languages that offer a way of dealing with
-	stack-allocated structures or tuples and generics. Essentialy on those targets a Null<T>
-	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<Null<T>>,
-	and do not follow Null<T> to its underlying type
-
-	Then we will run a syntax filter, which will look for casts to Null<T> and replace them by
-	a call to the new Null<T> creation;
-	Also casts from Null<T> to T or direct uses of Null<T> (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<T> and haxe.lang.Null<T> 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<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<T>, 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

src/codegen/gencommon/initFunction.ml

@@ -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 cl.cl_init 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
-	| _ -> cl.cl_init <- Some (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

src/codegen/gencommon/intDivisionSynf.ml

@@ -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

src/codegen/gencommon/interfaceProps.ml

@@ -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
-	| _ ->
-		()

src/codegen/gencommon/interfaceVarsDeleteModf.ml

@@ -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

src/codegen/gencommon/normalize.ml

@@ -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 _ } as c,_) when Meta.has Meta.EnumConstructorParam c.cl_meta ->
-		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

src/codegen/gencommon/objectDeclMap.ml

@@ -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

src/codegen/gencommon/overloadingConstructor.ml

@@ -1,459 +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 (fun tp -> {tp with ttp_type = TInst(map_param (get_cl_t tp.ttp_type), [])}) cl.cl_params in
-		let ctor_type_params = extract_param_types ctor_types in
-		List.iter (function {ttp_type=TInst(c,[])} -> (
-			match c.cl_kind with
-			| KTypeParameter (hd :: tail) ->
-				let before = hd :: tail in
-				let after = List.map (apply_params cl.cl_params ctor_type_params) (before) in
-				c.cl_kind <- KTypeParameter(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

src/codegen/gencommon/realTypeParams.ml

@@ -1,787 +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 <Dynamic> 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 <Dynamic> type parameter for them. Also any reference to <Dynamic> 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<Int> will return false for instance is Array<object> .
-
-	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 = match follow tp.ttp_type with
-					| TInst(c,_) ->
-						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 (fun tp -> {tp with ttp_type=TInst (map_param (get_cl_t tp.ttp_type), [])}) 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 (fun tp -> {tp with ttp_type = TInst (map_param (get_cl_t tp.ttp_type), [])}) 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<T2>(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 (fun tp -> {tp with ttp_name = "To_" ^ tp.ttp_name;ttp_type = TInst (map_param (get_cl_t tp.ttp_type), [])}) 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<ExplicitParameterDefinition>() 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 (fun tp -> {tp with ttp_name = "To_" ^ tp.ttp_name;ttp_type = TInst(map_param (get_cl_t tp.ttp_type), [])}) 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)

src/codegen/gencommon/reflectionCFs.ml

@@ -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 <implements Dynamic> 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<String>)
-		{
-			//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

src/codegen/gencommon/renameTypeParameters.ml

@@ -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 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 get_cls t =
-		match follow t with
-		| TInst(cl,_) -> cl
-		| _ -> Globals.die "" __LOC__
-	in
-
-	let iter_types tp =
-		let cls = get_cls tp.ttp_type 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 = get_cls tp.ttp_type in
-			(cls.cl_path,tp.ttp_type) :: 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 = get_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

src/codegen/gencommon/setHXGen.ml

@@ -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

src/codegen/gencommon/switchToIf.ml

@@ -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

src/codegen/gencommon/tArrayTransform.ml

@@ -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

src/codegen/gencommon/unnecessaryCastsRemoval.ml

@@ -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

src/codegen/gencommon/unreachableCodeEliminationSynf.ml

@@ -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

src/codegen/genxml.ml

@@ -81,7 +81,7 @@ let rec follow_param t =
 		t
 
 let gen_meta meta =
-	let meta = List.filter (fun (m,_,_) -> match m with Meta.Used | Meta.MaybeUsed | Meta.RealPath | Meta.Pure -> false | _ -> true) meta in
+	let meta = List.filter (fun (m,_,_) -> match m with Meta.Used | Meta.RealPath | Meta.Pure | Meta.HxbId -> false | _ -> true) meta in
 	match meta with
 	| [] -> []
 	| _ ->

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;
+}

src/codegen/java.ml

@@ -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<Type> 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<T>` 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<Int>` 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
-			| "<init>" -> "new"
-			| "<clinit>"-> 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

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

src/codegen/overloads.ml

@@ -1,6 +1,6 @@
 open Globals
 open Type
-open Typecore
+open FieldCallCandidate
 
 let same_overload_args ?(get_vmtype) t1 t2 f1 f2 =
 	let f_transform = match get_vmtype with
@@ -13,13 +13,10 @@ let same_overload_args ?(get_vmtype) t1 t2 f1 f2 =
 			| [],[] ->
 				true
 			| tp1 :: params1,tp2 :: params2 ->
-				let constraints_equal t1 t2 = match follow t1,follow t2 with
-					| TInst({cl_kind = KTypeParameter tl1},_),TInst({cl_kind = KTypeParameter tl2},_) ->
-						Ast.safe_for_all2 f_eq tl1 tl2
-					| _ ->
-						false
+				let constraints_equal ttp1 ttp2 =
+					Ast.safe_for_all2 f_eq (get_constraints ttp2) (get_constraints ttp2)
 				in
-				tp1.ttp_name = tp2.ttp_name && constraints_equal tp1.ttp_type tp2.ttp_type && loop params1 params2
+				tp1.ttp_name = tp2.ttp_name && constraints_equal tp1 tp2 && loop params1 params2
 			| [],_
 			| _,[] ->
 				false
@@ -82,14 +79,6 @@ let collect_overloads map c i =
 	loop map c;
 	List.rev !acc
 
-let get_overloads (com : Common.context) c i =
-	try
-		com.overload_cache#find (c.cl_path,i)
-	with Not_found ->
-		let l = collect_overloads (fun t -> t) c i in
-		com.overload_cache#add (c.cl_path,i) l;
-		l
-
 (** Overload resolution **)
 module Resolution =
 struct

src/compiler/args.ml

@@ -42,12 +42,13 @@ let process_args arg_spec =
 
 let parse_args com =
 	let usage = Printf.sprintf
-		"Haxe Compiler %s - (C)2005-2023 Haxe Foundation\nUsage: haxe%s <target> [options] [hxml files and dot paths...]\n"
+		"Haxe Compiler %s - (C)2005-2024 Haxe Foundation\nUsage: haxe%s <target> [options] [hxml files and dot paths...]\n"
 		s_version_full (if Sys.os_type = "Win32" then ".exe" else "")
 	in
 	let actx = {
 		classes = [([],"Std")];
 		xml_out = None;
+		hxb_out = None;
 		json_out = None;
 		cmds = [];
 		config_macros = [];
@@ -58,6 +59,7 @@ let parse_args com =
 		interp = false;
 		jvm_flag = false;
 		swf_version = false;
+		hxb_libs = [];
 		native_libs = [];
 		raise_usage = (fun () -> ());
 		display_arg = None;
@@ -66,7 +68,10 @@ let parse_args com =
 	let add_deprecation s =
 		actx.deprecations <- s :: actx.deprecations
 	in
-	let add_native_lib file extern = actx.native_libs <- (file,extern) :: actx.native_libs in
+	let add_native_lib file extern kind =
+		let lib = create_native_lib file extern kind in
+		actx.native_libs <- lib :: actx.native_libs
+	in
 	let basic_args_spec = [
 		("Target",["--js"],["-js"],Arg.String (set_platform com Js),"<file>","generate JavaScript code into target file");
 		("Target",["--lua"],["-lua"],Arg.String (set_platform com Lua),"<file>","generate Lua code into target file");
@@ -83,16 +88,9 @@ let parse_args com =
 			Common.define com Define.Cppia;
 			set_platform com Cpp file;
 		),"<file>","generate Cppia bytecode into target file");
-		("Target",["--cs"],["-cs"],Arg.String (fun dir ->
-			set_platform com Cs dir;
-		),"<directory>","generate C# code into target directory");
-		("Target",["--java"],["-java"],Arg.String (fun dir ->
-			set_platform com Java dir;
-		),"<directory>","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;
 		),"<file>","generate JVM bytecode into target file");
 		("Target",["--python"],["-python"],Arg.String (fun dir ->
 			set_platform com Python dir;
@@ -106,29 +104,36 @@ let parse_args com =
 		),"<name[=path]>","generate code for a custom target");
 		("Target",[],["-x"], Arg.String (fun cl ->
 			let cpath = Path.parse_type_path cl in
-			(match com.main_class with
+			(match com.main.main_class with
 				| Some c -> if cpath <> c then raise (Arg.Bad "Multiple --main classes specified")
-				| None -> com.main_class <- Some cpath);
+				| None -> com.main.main_class <- Some cpath);
 			actx.classes <- cpath :: actx.classes;
 			Common.define com Define.Interp;
-			set_platform com (!Globals.macro_platform) "";
+			set_platform com Eval "";
 			actx.interp <- true;
 		),"<class>","interpret the program using internal macro system");
 		("Target",["--interp"],[], Arg.Unit (fun() ->
 			Common.define com Define.Interp;
-			set_platform com (!Globals.macro_platform) "";
+			set_platform com Eval "";
 			actx.interp <- true;
 		),"","interpret the program using internal macro system");
 		("Target",["--run"],[], Arg.Unit (fun() ->
 			raise (Arg.Bad "--run requires an argument: a Haxe module name")
 		), "<module> [args...]","interpret a Haxe module with command line arguments");
 		("Compilation",["-p";"--class-path"],["-cp"],Arg.String (fun path ->
-			com.class_path <- Path.add_trailing_slash path :: com.class_path
+			com.class_paths#add (new ClassPath.directory_class_path (Path.add_trailing_slash path) User);
+		),"<path>","add a directory to find source files");
+		("Compilation",[],["-libcp"],Arg.String (fun path ->
+			com.class_paths#add (new ClassPath.directory_class_path (Path.add_trailing_slash path) Lib);
 		),"<path>","add a directory to find source files");
+		("Compilation",["--hxb-lib"],["-hxb-lib"],Arg.String (fun file ->
+			let lib = create_native_lib file false HxbLib in
+			actx.hxb_libs <- lib :: actx.hxb_libs
+		),"<path>","add a hxb library");
 		("Compilation",["-m";"--main"],["-main"],Arg.String (fun cl ->
-			if com.main_class <> None then raise (Arg.Bad "Multiple --main classes specified");
+			if com.main.main_class <> None then raise (Arg.Bad "Multiple --main classes specified");
 			let cpath = Path.parse_type_path cl in
-			com.main_class <- Some cpath;
+			com.main.main_class <- Some cpath;
 			actx.classes <- cpath :: actx.classes
 		),"<class>","select startup class");
 		("Compilation",["-L";"--library"],["-lib"],Arg.String (fun _ -> ()),"<name[:ver]>","use a haxelib library");
@@ -206,29 +211,20 @@ let parse_args com =
 			Common.define com Define.FlashStrict
 		), "","more type strict flash API");
 		("Target-specific",["--swf-lib"],["-swf-lib"],Arg.String (fun file ->
-			add_native_lib file false;
+			add_native_lib file false SwfLib;
 		),"<file>","add the SWF library to the compiled SWF");
 		("Target-specific",[],["--neko-lib-path"],Arg.String (fun dir ->
 			com.neko_lib_paths <- dir :: com.neko_lib_paths
 		),"<directory>","add the neko library path");
 		("Target-specific",["--swf-lib-extern"],["-swf-lib-extern"],Arg.String (fun file ->
-			add_native_lib file true;
+			add_native_lib file true SwfLib;
 		),"<file>","use the SWF library for type checking");
 		("Target-specific",["--java-lib"],["-java-lib"],Arg.String (fun file ->
-			add_native_lib file false;
+			add_native_lib file false JavaLib;
 		),"<file>","add an external JAR or directory of JAR files");
 		("Target-specific",["--java-lib-extern"],[],Arg.String (fun file ->
-			add_native_lib file true;
+			add_native_lib file true JavaLib;
 		),"<file>","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;
-		),"<file>[@std]","add an external .NET DLL file");
-		("Target-specific",["--net-std"],["-net-std"],Arg.String (fun file ->
-			Dotnet.add_net_std com file
-		),"<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
-		),"<arg>","pass option <arg> 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
@@ -266,6 +262,9 @@ let parse_args com =
 		("Services",["--json"],[],Arg.String (fun file ->
 			actx.json_out <- Some file
 		),"<file>","generate JSON types description");
+		("Services",["--hxb"],[], Arg.String (fun file ->
+			actx.hxb_out <- Some file;
+		),"<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 () ->
@@ -366,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;

src/compiler/compilationCache.ml

@@ -5,7 +5,7 @@ open Type
 open Define
 
 type cached_file = {
-	c_file_path : string;
+	c_file_path : ClassPaths.resolved_file;
 	c_time : float;
 	c_package : string list;
 	c_decls : type_decl list;
@@ -23,9 +23,18 @@ type cached_native_lib = {
 	c_nl_files : (path,Ast.package) Hashtbl.t;
 }
 
-class context_cache (index : int) = object(self)
+let get_module_name_of_cfile file cfile = match cfile.c_module_name with
+	| None ->
+		let name = Path.module_name_of_file file in
+		cfile.c_module_name <- Some name;
+		name
+	| Some name ->
+		name
+
+class context_cache (index : int) (sign : Digest.t) = object(self)
 	val files : (Path.UniqueKey.t,cached_file) Hashtbl.t = Hashtbl.create 0
 	val modules : (path,module_def) Hashtbl.t = Hashtbl.create 0
+	val binary_cache : (path,HxbData.module_cache) Hashtbl.t = Hashtbl.create 0
 	val removed_files = Hashtbl.create 0
 	val mutable json = JNull
 	val mutable initialized = false
@@ -57,17 +66,41 @@ class context_cache (index : int) = object(self)
 	method find_module_opt path =
 		Hashtbl.find_opt modules path
 
-	method cache_module path value =
-		Hashtbl.replace modules path value
+	method find_module_extra path =
+		try (Hashtbl.find modules path).m_extra with Not_found -> (Hashtbl.find binary_cache path).mc_extra
+
+	method cache_module config warn anon_identification path m =
+		match m.m_extra.m_kind with
+		| MImport ->
+			Hashtbl.add modules m.m_path m
+		| _ ->
+			let writer = HxbWriter.create config warn anon_identification in
+			HxbWriter.write_module writer m;
+			let chunks = HxbWriter.get_chunks writer in
+			Hashtbl.replace binary_cache path {
+				mc_path = path;
+				mc_id = m.m_id;
+				mc_chunks = chunks;
+				mc_extra = { m.m_extra with m_cache_state = MSGood }
+			}
+
+	method clear_cache =
+		Hashtbl.clear modules
 
 	(* initialization *)
 
 	method is_initialized = initialized
 	method set_initialized value = initialized <- value
 
+	method get_sign = sign
 	method get_index = index
 	method get_files = files
 	method get_modules = modules
+
+	method get_hxb = binary_cache
+	method get_hxb_module path = Hashtbl.find binary_cache path
+
+	(* TODO handle hxb cache there too *)
 	method get_removed_files = removed_files
 
 	method get_json = json
@@ -75,7 +108,7 @@ class context_cache (index : int) = object(self)
 
 (* Pointers for memory inspection. *)
 	method get_pointers : unit array =
-		[|Obj.magic files;Obj.magic modules|]
+		[|Obj.magic files;Obj.magic modules;Obj.magic binary_cache|]
 end
 
 let create_directory path mtime = {
@@ -109,24 +142,32 @@ 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 =
 		try
 			Hashtbl.find contexts sign
 		with Not_found ->
-			let cache = new context_cache (Hashtbl.length contexts) in
+			let cache = new context_cache (Hashtbl.length contexts) sign in
 			context_list <- cache :: context_list;
 			Hashtbl.add contexts sign cache;
 			cache
 
-	method add_info sign desc platform class_path defines =
+	method add_info sign desc platform (class_paths : ClassPaths.class_paths) defines =
 		let cc = self#get_context sign in
 		let jo = JObject [
 			"index",JInt cc#get_index;
 			"desc",JString desc;
 			"platform",JString (platform_name platform);
-			"classPaths",JArray (List.map (fun s -> JString s) class_path);
+			"classPaths",JArray (List.map (fun s -> JString s) class_paths#as_string_list);
 			"signature",JString (Digest.to_hex sign);
 			"defines",JArray (PMap.foldi (fun k v acc -> JObject [
 				"key",JString k;
@@ -174,7 +215,14 @@ class cache = object(self)
 		Hashtbl.iter (fun _ cc ->
 			Hashtbl.iter (fun _ m ->
 				if Path.UniqueKey.lazy_key m.m_extra.m_file = file_key then m.m_extra.m_cache_state <- MSBad (Tainted reason)
-			) cc#get_modules
+			) cc#get_modules;
+			let open HxbData in
+			Hashtbl.iter (fun _ mc ->
+				if Path.UniqueKey.lazy_key mc.mc_extra.m_file = file_key then
+					mc.mc_extra.m_cache_state <- match reason, mc.mc_extra.m_cache_state with
+					| CheckDisplayFile, (MSBad _ as state) -> state
+					| _ -> MSBad (Tainted reason)
+			) cc#get_hxb
 		) contexts
 
 	(* haxelibs *)
@@ -267,11 +315,3 @@ type context_options =
 	| NormalContext
 	| MacroContext
 	| NormalAndMacroContext
-
-let get_module_name_of_cfile file cfile = match cfile.c_module_name with
-	| None ->
-		let name = Path.module_name_of_file file in
-		cfile.c_module_name <- Some name;
-		name
-	| Some name ->
-		name

src/compiler/compilationContext.ml

@@ -7,9 +7,21 @@ type server_mode =
 	| SMListen of string
 	| SMConnect of string
 
+type native_lib_kind =
+	| JavaLib
+	| SwfLib
+	| HxbLib
+
+type native_lib_arg = {
+	lib_file : string;
+	lib_kind : native_lib_kind;
+	lib_extern : bool;
+}
+
 type arg_context = {
 	mutable classes : Globals.path list;
 	mutable xml_out : string option;
+	mutable hxb_out : string option;
 	mutable json_out : string option;
 	mutable cmds : string list;
 	mutable config_macros : string list;
@@ -20,7 +32,8 @@ type arg_context = {
 	mutable interp : bool;
 	mutable jvm_flag : bool;
 	mutable swf_version : bool;
-	mutable native_libs : (string * bool) list;
+	mutable hxb_libs : native_lib_arg list;
+	mutable native_libs : native_lib_arg list;
 	mutable raise_usage : unit -> unit;
 	mutable display_arg : string option;
 	mutable deprecations : string list;
@@ -40,11 +53,13 @@ and compilation_context = {
 	mutable has_next : bool;
 	mutable has_error : bool;
 	comm : communication;
+	mutable runtime_args : string list;
 }
 
 type compilation_callbacks = {
 	before_anything : compilation_context -> unit;
 	after_target_init : compilation_context -> unit;
+	after_save : compilation_context -> unit;
 	after_compilation : compilation_context -> unit;
 }
 
@@ -73,3 +88,8 @@ let error_ext ctx (err : Error.error) =
 		error ~depth ~from_macro:err.err_from_macro ctx (Error.error_msg err.err_message) err.err_pos
 	) err
 
+let create_native_lib file extern kind = {
+	lib_file = file;
+	lib_extern = extern;
+	lib_kind = kind;
+}

src/compiler/compiler.ml

@@ -2,29 +2,35 @@ open Globals
 open Common
 open CompilationContext
 
-let run_or_diagnose ctx f arg =
+let run_or_diagnose ctx f =
 	let com = ctx.com in
-	let handle_diagnostics ?(depth = 0) msg p kind =
+	let handle_diagnostics msg p kind =
 		ctx.has_error <- true;
-		add_diagnostics_message ~depth com msg p kind Error;
-		DisplayOutput.emit_diagnostics ctx.com
+		add_diagnostics_message com msg p kind Error;
+		match com.report_mode with
+		| RMLegacyDiagnostics _ -> DisplayOutput.emit_legacy_diagnostics ctx.com
+		| RMDiagnostics _ -> DisplayOutput.emit_diagnostics ctx.com
+		| _ -> die "" __LOC__
 	in
 	if is_diagnostics com then begin try
-			f arg
+			f ()
 		with
 		| Error.Error err ->
 			ctx.has_error <- true;
 			Error.recurse_error (fun depth err ->
 				add_diagnostics_message ~depth com (Error.error_msg err.err_message) err.err_pos DKCompilerMessage Error
 			) err;
-			DisplayOutput.emit_diagnostics ctx.com
+			(match com.report_mode with
+			| RMLegacyDiagnostics _ -> DisplayOutput.emit_legacy_diagnostics ctx.com
+			| RMDiagnostics _ -> DisplayOutput.emit_diagnostics ctx.com
+			| _ -> die "" __LOC__)
 		| Parser.Error(msg,p) ->
 			handle_diagnostics (Parser.error_msg msg) p DKParserError
 		| Lexer.Error(msg,p) ->
 			handle_diagnostics (Lexer.error_msg msg) p DKParserError
 		end
 	else
-		f arg
+		f ()
 
 let run_command ctx cmd =
 	let t = Timer.timer ["command";cmd] in
@@ -72,8 +78,15 @@ let run_command ctx cmd =
 module Setup = struct
 	let initialize_target ctx com actx =
 		init_platform com;
+		com.class_paths#lock_context (platform_name com.platform) false;
 		let add_std dir =
-			com.class_path <- List.filter (fun s -> not (List.mem s com.std_path)) com.class_path @ List.map (fun p -> p ^ dir ^ "/_std/") com.std_path @ com.std_path
+			com.class_paths#modify_inplace (fun cp -> match cp#scope with
+				| Std ->
+					let cp' = new ClassPath.directory_class_path (cp#path ^ dir ^ "/_std/") StdTarget in
+					cp :: [cp']
+				| _ ->
+					[cp]
+			);
 		in
 		match com.platform with
 			| Cross ->
@@ -125,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 ->
@@ -156,9 +163,14 @@ module Setup = struct
 				add_std "eval";
 				"eval"
 
-	let create_typer_context ctx macros native_libs =
+	let init_native_libs com native_libs =
+		(* Native lib pass 1: Register *)
+		let fl = List.map (fun lib -> NativeLibraryHandler.add_native_lib com lib) (List.rev native_libs) in
+		(* Native lib pass 2: Initialize *)
+		List.iter (fun f -> f()) fl
+
+	let create_typer_context ctx macros =
 		let com = ctx.com in
-		Common.log com ("Classpath: " ^ (String.concat ";" com.class_path));
 		let buffer = Buffer.create 64 in
 		Buffer.add_string buffer "Defines: ";
 		PMap.iter (fun k v -> match v with
@@ -168,15 +180,13 @@ module Setup = struct
 		Buffer.truncate buffer (Buffer.length buffer - 1);
 		Common.log com (Buffer.contents buffer);
 		com.callbacks#run com.error_ext com.callbacks#get_before_typer_create;
-		(* Native lib pass 1: Register *)
-		let fl = List.map (fun (file,extern) -> NativeLibraryHandler.add_native_lib com file extern) (List.rev native_libs) in
-		(* Native lib pass 2: Initialize *)
-		List.iter (fun f -> f()) fl;
-		Typer.create com macros
+		TyperEntry.create com macros
 
 	let executable_path() =
 		Extc.executable_path()
 
+	open ClassPath
+
 	let get_std_class_paths () =
 		try
 			let p = Sys.getenv "HAXE_STD_PATH" in
@@ -190,7 +200,7 @@ module Setup = struct
 					l
 			in
 			let parts = Str.split_delim (Str.regexp "[;:]") p in
-			"" :: List.map Path.add_trailing_slash (loop parts)
+			List.map (fun s -> s,Std) (loop parts)
 		with Not_found ->
 			let base_path = Path.get_real_path (try executable_path() with _ -> "./") in
 			if Sys.os_type = "Unix" then
@@ -198,21 +208,24 @@ module Setup = struct
 				let lib_path = Filename.concat prefix_path "lib" in
 				let share_path = Filename.concat prefix_path "share" in
 				[
-					"";
-					Path.add_trailing_slash (Filename.concat lib_path "haxe/std");
-					Path.add_trailing_slash (Filename.concat lib_path "haxe/extraLibs");
-					Path.add_trailing_slash (Filename.concat share_path "haxe/std");
-					Path.add_trailing_slash (Filename.concat share_path "haxe/extraLibs");
-					Path.add_trailing_slash (Filename.concat base_path "std");
-					Path.add_trailing_slash (Filename.concat base_path "extraLibs")
+					(Filename.concat share_path "haxe/std"),Std;
+					(Filename.concat lib_path "haxe/std"),Std;
+					(Filename.concat base_path "std"),Std;
 				]
 			else
 				[
-					"";
-					Path.add_trailing_slash (Filename.concat base_path "std");
-					Path.add_trailing_slash (Filename.concat base_path "extraLibs")
+					(Filename.concat base_path "std"),Std;
 				]
 
+	let init_std_class_paths com =
+		List.iter (fun (s,scope) ->
+			try if Sys.is_directory s then
+				let cp = new ClassPath.directory_class_path (Path.add_trailing_slash s) scope in
+				com.class_paths#add cp
+			with Sys_error _ -> ()
+		) (List.rev (get_std_class_paths ()));
+		com.class_paths#add com.empty_class_path
+
 	let setup_common_context ctx =
 		let com = ctx.com in
 		ctx.com.print <- ctx.comm.write_out;
@@ -252,8 +265,7 @@ module Setup = struct
 		) (filter_messages false (fun _ -> true))));
 		com.filter_messages <- (fun predicate -> (ctx.messages <- (List.rev (filter_messages true predicate))));
 		com.run_command <- run_command ctx;
-		com.class_path <- get_std_class_paths ();
-		com.std_path <- List.filter (fun p -> ExtString.String.ends_with p "std/" || ExtString.String.ends_with p "std\\") com.class_path
+		init_std_class_paths com
 
 end
 
@@ -270,23 +282,23 @@ let check_defines com =
 	end
 
 (** Creates the typer context and types [classes] into it. *)
-let do_type ctx mctx actx display_file_dot_path macro_cache_enabled =
+let do_type ctx mctx actx display_file_dot_path =
 	let com = ctx.com in
 	let t = Timer.timer ["typing"] in
 	let cs = com.cs in
 	CommonCache.maybe_add_context_sign cs com "before_init_macros";
 	enter_stage com CInitMacrosStart;
 	ServerMessage.compiler_stage com;
-
+	Setup.init_native_libs com actx.hxb_libs;
 	let mctx = List.fold_left (fun mctx path ->
 		Some (MacroContext.call_init_macro ctx.com mctx path)
 	) mctx (List.rev actx.config_macros) in
 	enter_stage com CInitMacrosDone;
 	ServerMessage.compiler_stage com;
-	MacroContext.macro_enable_cache := macro_cache_enabled;
 
 	let macros = match mctx with None -> None | Some mctx -> mctx.g.macros in
-	let tctx = Setup.create_typer_context ctx macros actx.native_libs in
+	Setup.init_native_libs com actx.native_libs;
+	let tctx = Setup.create_typer_context ctx macros in
 	let display_file_dot_path = DisplayProcessing.maybe_load_display_file_before_typing tctx display_file_dot_path in
 	check_defines ctx.com;
 	CommonCache.lock_signature com "after_init_macros";
@@ -297,7 +309,7 @@ let do_type ctx mctx actx display_file_dot_path macro_cache_enabled =
 			if com.display.dms_kind <> DMNone then DisplayTexpr.check_display_file tctx cs;
 			List.iter (fun cpath -> ignore(tctx.Typecore.g.Typecore.do_load_module tctx cpath null_pos)) (List.rev actx.classes);
 			Finalization.finalize tctx;
-		) ();
+		);
 	end with TypeloadParse.DisplayInMacroBlock ->
 		ignore(DisplayProcessing.load_display_module_in_macro tctx display_file_dot_path true)
 	);
@@ -317,8 +329,8 @@ let finalize_typing ctx tctx =
 	let com = ctx.com in
 	enter_stage com CFilteringStart;
 	ServerMessage.compiler_stage com;
-	let main, types, modules = run_or_diagnose ctx Finalization.generate tctx in
-	com.main <- main;
+	let main, types, modules = run_or_diagnose ctx (fun () -> Finalization.generate tctx) in
+	com.main.main_expr <- main;
 	com.types <- types;
 	com.modules <- modules;
 	t()
@@ -326,7 +338,7 @@ let finalize_typing ctx tctx =
 let filter ctx tctx before_destruction =
 	let t = Timer.timer ["filters"] in
 	DeprecationCheck.run ctx.com;
-	run_or_diagnose ctx Filters.run tctx ctx.com.main before_destruction;
+	run_or_diagnose ctx (fun () -> Filters.run tctx ctx.com.main.main_expr before_destruction);
 	t()
 
 let compile ctx actx callbacks =
@@ -334,8 +346,6 @@ let compile ctx actx callbacks =
 	(* Set up display configuration *)
 	DisplayProcessing.process_display_configuration ctx;
 	let display_file_dot_path = DisplayProcessing.process_display_file com actx in
-	let macro_cache_enabled = !MacroContext.macro_enable_cache in
-	MacroContext.macro_enable_cache := true;
 	let mctx = match com.platform with
 		| CustomTarget name ->
 			begin try
@@ -353,6 +363,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;
@@ -360,9 +376,18 @@ let compile ctx actx callbacks =
 		if actx.cmds = [] && not actx.did_something then actx.raise_usage();
 	end else begin
 		(* Actual compilation starts here *)
-		let (tctx,display_file_dot_path) = do_type ctx mctx actx display_file_dot_path macro_cache_enabled in
+		let (tctx,display_file_dot_path) = do_type ctx mctx actx display_file_dot_path in
 		DisplayProcessing.handle_display_after_typing ctx tctx display_file_dot_path;
 		finalize_typing ctx tctx;
+		let is_compilation = is_compilation com in
+		com.callbacks#add_after_save (fun () ->
+			callbacks.after_save ctx;
+			if is_compilation then match com.hxb_writer_config with
+				| Some config ->
+					Generate.check_hxb_output ctx config;
+				| None ->
+					()
+		);
 		if is_diagnostics com then
 			filter ctx tctx (fun () -> DisplayProcessing.handle_display_after_finalization ctx tctx display_file_dot_path)
 		else begin
@@ -370,9 +395,10 @@ let compile ctx actx callbacks =
 			filter ctx tctx (fun () -> ());
 		end;
 		if ctx.has_error then raise Abort;
-		Generate.check_auxiliary_output com actx;
+		if is_compilation then Generate.check_auxiliary_output com actx;
 		enter_stage com CGenerationStart;
 		ServerMessage.compiler_stage com;
+		Generate.maybe_generate_dump ctx tctx;
 		if not actx.no_output then Generate.generate ctx tctx ext actx;
 		enter_stage com CGenerationDone;
 		ServerMessage.compiler_stage com;
@@ -422,7 +448,7 @@ with
 		error ctx ("Error: No completion point was found") null_pos
 	| DisplayException.DisplayException dex ->
 		DisplayOutput.handle_display_exception ctx dex
-	| Out_of_memory | EvalExceptions.Sys_exit _ | Hlinterp.Sys_exit _ | DisplayProcessingGlobals.Completion _ as exc ->
+	| Out_of_memory | EvalTypes.Sys_exit _ | Hlinterp.Sys_exit _ | DisplayProcessingGlobals.Completion _ as exc ->
 		(* We don't want these to be caught by the catchall below *)
 		raise exc
 	| e when (try Sys.getenv "OCAMLRUNPARAM" <> "b" with _ -> true) && not Helper.is_debug_run ->
@@ -430,11 +456,11 @@ with
 
 let finalize ctx =
 	ctx.comm.flush ctx;
+	List.iter (fun lib -> lib#close) ctx.com.hxb_libs;
 	(* In server mode any open libs are closed by the lib_build_task. In offline mode
 		we should do it here to be safe. *)
 	if not ctx.comm.is_server then begin
 		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
 
@@ -448,7 +474,7 @@ let catch_completion_and_exit ctx callbacks run =
 			ServerMessage.completion str;
 			ctx.comm.write_err str;
 			0
-		| EvalExceptions.Sys_exit i | Hlinterp.Sys_exit i ->
+		| EvalTypes.Sys_exit i | Hlinterp.Sys_exit i ->
 			if i <> 0 then ctx.has_error <- true;
 			finalize ctx;
 			i
@@ -481,11 +507,12 @@ let compile_ctx callbacks ctx =
 		catch_completion_and_exit ctx callbacks run
 
 let create_context comm cs compilation_step params = {
-	com = Common.create compilation_step cs version params;
+	com = Common.create compilation_step cs version params (DisplayTypes.DisplayMode.create !Parser.display_mode);
 	messages = [];
 	has_next = false;
 	has_error = false;
 	comm = comm;
+	runtime_args = [];
 }
 
 module HighLevel = struct
@@ -529,7 +556,7 @@ module HighLevel = struct
 				if l = "" then
 					acc
 				else if l.[0] <> '-' then
-					"-cp" :: l :: acc
+					"-libcp" :: l :: acc
 				else match (try ExtString.String.split l " " with _ -> l, "") with
 				| ("-L",dir) ->
 					"--neko-lib-path" :: (String.sub l 3 (String.length l - 3)) :: acc
@@ -591,7 +618,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
@@ -599,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) ->

src/compiler/displayOutput.ml

@@ -326,7 +326,10 @@ let handle_display_exception_json ctx dex api =
 		let ctx = DisplayJson.create_json_context api.jsonrpc (match dex with DisplayFields _ -> true | _ -> false) in
 		api.send_result (DisplayException.to_json ctx dex)
 	| DisplayNoResult ->
-		api.send_result JNull
+		(match ctx.com.display.dms_kind with
+			| DMDefault -> api.send_error [jstring "No completion point"]
+			| _ -> api.send_result JNull
+		)
 	| _ ->
 		handle_display_exception_old ctx dex
 
@@ -344,7 +347,7 @@ let handle_type_path_exception ctx p c is_import pos =
 			| None ->
 				DisplayPath.TypePathHandler.complete_type_path com p
 			| Some (c,cur_package) ->
-				let ctx = Typer.create com None in
+				let ctx = TyperEntry.create com None in
 				DisplayPath.TypePathHandler.complete_type_path_inner ctx p c cur_package is_import
 		end with Error.Fatal_error err ->
 			error_ext ctx err;
@@ -368,12 +371,22 @@ let handle_type_path_exception ctx p c is_import pos =
 		api.send_result (DisplayException.fields_to_json ctx fields kind (DisplayTypes.make_subject None pos));
 	end
 
-let emit_diagnostics com =
+let emit_legacy_diagnostics com =
 	let dctx = Diagnostics.run com in
 	let s = Json.string_of_json (DiagnosticsPrinter.json_of_diagnostics com dctx) in
 	DisplayPosition.display_position#reset;
 	raise (Completion s)
 
+let emit_diagnostics com =
+	(match com.Common.json_out with
+	| None -> die "" __LOC__
+	| Some api ->
+		let dctx = Diagnostics.run com in
+		let diagnostics = DiagnosticsPrinter.json_of_diagnostics com dctx in
+		DisplayPosition.display_position#reset;
+		api.send_result diagnostics;
+		raise Abort (* not reached because send_result always raises *))
+
 let emit_statistics tctx =
 	let stats = Statistics.collect_statistics tctx [SFFile (DisplayPosition.display_position#get).pfile] true in
 	let s = Statistics.Printer.print_statistics stats in

src/compiler/displayProcessing.ml

@@ -22,7 +22,7 @@ let handle_display_argument_old com file_pos actx =
 		actx.did_something <- true;
 		(try Memory.display_memory com with e -> prerr_endline (Printexc.get_backtrace ()));
 	| "diagnostics" ->
-		com.report_mode <- RMDiagnostics []
+		com.report_mode <- RMLegacyDiagnostics []
 	| _ ->
 		let file, pos = try ExtString.String.split file_pos "@" with _ -> failwith ("Invalid format: " ^ file_pos) in
 		let file = Helper.unquote file in
@@ -46,9 +46,9 @@ let handle_display_argument_old com file_pos actx =
 			| "module-symbols" ->
 				create (DMModuleSymbols None)
 			| "diagnostics" ->
-				com.report_mode <- RMDiagnostics [file_unique];
+				com.report_mode <- RMLegacyDiagnostics [file_unique];
 				let dm = create DMNone in
-				{dm with dms_display_file_policy = DFPAlso; dms_per_file = true; dms_populate_cache = !ServerConfig.populate_cache_from_display}
+				{dm with dms_display_file_policy = DFPOnly; dms_per_file = true; dms_populate_cache = !ServerConfig.populate_cache_from_display}
 			| "statistics" ->
 				com.report_mode <- RMStatistics;
 				let dm = create DMNone in
@@ -121,6 +121,7 @@ let process_display_file com actx =
 		let rec loop = function
 			| [] -> None
 			| cp :: l ->
+				let cp = cp#path in
 				let cp = (if cp = "" then "./" else cp) in
 				let c = Path.add_trailing_slash (Path.get_real_path cp) in
 				let clen = String.length c in
@@ -135,25 +136,25 @@ let process_display_file com actx =
 				end else
 					loop l
 		in
-		loop com.class_path
+		loop com.class_paths#as_list
 	in
 	match com.display.dms_display_file_policy with
 		| DFPNo ->
 			DPKNone
 		| DFPOnly when (DisplayPosition.display_position#get).pfile = file_input_marker ->
 			actx.classes <- [];
-			com.main_class <- None;
-			begin match !TypeloadParse.current_stdin with
-			| Some input ->
-				TypeloadParse.current_stdin := None;
+			com.main.main_class <- None;
+			begin match com.file_contents with
+			| [_, Some input] ->
+				com.file_contents <- [];
 				DPKInput input
-			| None ->
+			| _ ->
 				DPKNone
 			end
 		| dfp ->
 			if dfp = DFPOnly then begin
 				actx.classes <- [];
-				com.main_class <- None;
+				com.main.main_class <- None;
 			end;
 			let real = Path.get_real_path (DisplayPosition.display_position#get).pfile in
 			let path = match get_module_path_from_file_path com real with
@@ -200,11 +201,11 @@ let load_display_module_in_macro tctx display_file_dot_path clear = match displa
 				begin try
 					let m = mctx.com.module_lut#find cpath in
 					mctx.com.module_lut#remove cpath;
-					mctx.com.type_to_module#remove cpath;
+					mctx.com.module_lut#get_type_lut#remove cpath;
 					List.iter (fun mt ->
 						let ti = Type.t_infos mt in
 						mctx.com.module_lut#remove ti.mt_path;
-						mctx.com.type_to_module#remove ti.mt_path;
+						mctx.com.module_lut#get_type_lut#remove ti.mt_path;
 					) m.m_types
 				with Not_found ->
 					()
@@ -223,7 +224,7 @@ let load_display_module_in_macro tctx display_file_dot_path clear = match displa
 
 let load_display_file_standalone (ctx : Typecore.typer) file =
 	let com = ctx.com in
-	let pack,decls = TypeloadParse.parse_module_file com file null_pos in
+	let pack,decls = TypeloadParse.parse_module_file com (ClassPaths.create_resolved_file file ctx.com.empty_class_path) null_pos in
 	let path = Path.FilePath.parse file in
 	let name = match path.file_name with
 		| None -> "?DISPLAY"
@@ -236,9 +237,9 @@ let load_display_file_standalone (ctx : Typecore.typer) file =
 			let parts = ExtString.String.nsplit dir (if path.backslash then "\\" else "/") in
 			let parts = List.rev (ExtList.List.drop (List.length pack) (List.rev parts)) in
 			let dir = ExtString.String.join (if path.backslash then "\\" else "/") parts in
-			com.class_path <- dir :: com.class_path
+			com.class_paths#add (new ClassPath.directory_class_path dir User)
 	end;
-	ignore(TypeloadModule.type_module ctx (pack,name) file ~dont_check_path:true decls null_pos)
+	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
@@ -246,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 *)
 
@@ -318,7 +319,7 @@ let process_global_display_mode com tctx =
 		let symbols =
 			let l = cs#get_context_files ((Define.get_signature com.defines) :: (match com.get_macros() with None -> [] | Some com -> [Define.get_signature com.defines])) in
 			List.fold_left (fun acc (file_key,cfile) ->
-				let file = cfile.c_file_path in
+				let file = cfile.c_file_path.file in
 				if (filter <> None || DisplayPosition.display_position#is_in_file (com.file_keys#get file)) then
 					(file,DocumentSymbols.collect_module_symbols (Some (file,get_module_name_of_cfile file cfile)) (filter = None) (cfile.c_package,cfile.c_decls)) :: acc
 				else
@@ -348,6 +349,8 @@ let handle_display_after_finalization ctx tctx display_file_dot_path =
 	end;
 	process_global_display_mode com tctx;
 	begin match com.report_mode with
+	| RMLegacyDiagnostics _ ->
+		DisplayOutput.emit_legacy_diagnostics com
 	| RMDiagnostics _ ->
 		DisplayOutput.emit_diagnostics com
 	| RMStatistics ->

src/compiler/generate.ml

@@ -1,5 +1,7 @@
 open Globals
 open CompilationContext
+open TType
+open Tanon_identification
 
 let check_auxiliary_output com actx =
 	begin match actx.xml_out with
@@ -19,6 +21,76 @@ let check_auxiliary_output com actx =
 			Genjson.generate com.types file
 	end
 
+let export_hxb com config cc platform zip m =
+	let open HxbData in
+	match m.m_extra.m_kind with
+		| MCode | MMacro | MFake | MExtern -> begin
+			(* Printf.eprintf "Export module %s\n" (s_type_path m.m_path); *)
+			let l = platform :: (fst m.m_path @ [snd m.m_path]) in
+			let path = (String.concat "/" l) ^ ".hxb" in
+
+			try
+				let hxb_cache = cc#get_hxb_module m.m_path in
+				let out = IO.output_string () in
+				write_header out;
+				List.iter (fun (kind,data) ->
+					write_chunk_prefix kind (Bytes.length data) out;
+					IO.nwrite out data
+				) hxb_cache.mc_chunks;
+				let data = IO.close_out out in
+				zip#add_entry data path;
+			with Not_found ->
+				let anon_identification = new tanon_identification in
+				let warn w s p = com.Common.warning w com.warning_options s p in
+				let writer = HxbWriter.create config warn anon_identification in
+				HxbWriter.write_module writer m;
+				let out = IO.output_string () in
+				HxbWriter.export writer out;
+				zip#add_entry (IO.close_out out) path;
+		end
+	| _ ->
+		()
+
+let check_hxb_output ctx config =
+	let open HxbWriterConfig in
+	let com = ctx.com in
+	let match_path_list l sl_path =
+		List.exists (fun sl -> Ast.match_path true sl_path sl) l
+	in
+	let try_write () =
+		let path = config.HxbWriterConfig.archive_path in
+		let path = Str.global_replace (Str.regexp "\\$target") (platform_name ctx.com.platform) path in
+		let t = Timer.timer ["generate";"hxb"] in
+		Path.mkdir_from_path path;
+		let zip = new Zip_output.zip_output path 6 in
+		let export com config =
+			let cc = CommonCache.get_cache com in
+			let target = Common.platform_name_macro com in
+			List.iter (fun m ->
+				let t = Timer.timer ["generate";"hxb";s_type_path m.m_path] in
+				let sl_path = fst m.m_path @ [snd m.m_path] in
+				if not (match_path_list config.exclude sl_path) || match_path_list config.include' sl_path then
+					Std.finally t (export_hxb com config cc target zip) m
+			) com.modules;
+		in
+		Std.finally (fun () ->
+			zip#close;
+			t()
+		) (fun () ->
+			if  config.target_config.generate then
+				export com config.target_config;
+			begin match com.get_macros() with
+				| Some mcom when config.macro_config.generate ->
+					export mcom config.macro_config
+				| _ ->
+					()
+			end;
+		) ()
+	in
+	try
+		try_write ()
+	with Sys_error s ->
+		CompilationContext.error ctx (Printf.sprintf "Could not write to %s: %s" config.archive_path s) null_pos
 
 let parse_swf_header ctx h = match ExtString.String.nsplit h ":" with
 		| [width; height; fps] ->
@@ -32,12 +104,8 @@ let parse_swf_header ctx h = match ExtString.String.nsplit h ":" with
 
 let delete_file f = try Sys.remove f with _ -> ()
 
-let generate ctx tctx ext actx =
+let maybe_generate_dump ctx tctx =
 	let com = tctx.Typecore.com in
-	(* check file extension. In case of wrong commandline, we don't want
-		to accidentaly delete a source file. *)
-	if Path.file_extension com.file = ext then delete_file com.file;
-	if com.platform = Flash || com.platform = Cpp || com.platform = Hl then List.iter (Codegen.fix_overrides com) com.types;
 	if Common.defined com Define.Dump then begin
 		Codegen.Dump.dump_types com;
 		Option.may Codegen.Dump.dump_types (com.get_macros())
@@ -47,17 +115,30 @@ let generate ctx tctx ext actx =
 		if not com.is_macro_context then match tctx.Typecore.g.Typecore.macros with
 			| None -> ()
 			| Some(_,ctx) -> Codegen.Dump.dump_dependencies ~target_override:(Some "macro") ctx.Typecore.com
-	end;
+	end
+
+let generate ctx tctx ext actx =
+	let com = tctx.Typecore.com in
+	(* check file extension. In case of wrong commandline, we don't want
+		to accidentaly delete a source file. *)
+	if Path.file_extension com.file = ext then delete_file com.file;
+	if com.platform = Flash || com.platform = Cpp || com.platform = Hl then List.iter (Codegen.fix_overrides com) com.types;
 	begin match com.platform with
 		| Neko | Hl | Eval when actx.interp -> ()
 		| Cpp when Common.defined com Define.Cppia -> ()
-		| 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
-		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
@@ -76,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 ->

src/compiler/hxb/hxbData.ml

@@ -0,0 +1,127 @@
+open Globals
+open Type
+
+exception HxbFailure of string
+
+(*
+	MD = module
+	MT = module type
+	CL = class
+	EN = enum
+	AB = abstract
+	TD = typedef
+	AN = anon
+	CF = class field
+	EF = enum field
+	AF = anon field
+	EX = expression
+	EO = end of (Types | Fields | Module)
+	..F = forward definition
+	..R = reference
+	..D = definition
+*)
+
+type chunk_kind =
+	| STR (* string pool *)
+	| DOC (* doc pool *)
+	| MDF (* module foward *)
+	| MTF (* module types forward *)
+	(* Module type references *)
+	| MDR (* module references *)
+	| CLR (* class references *)
+	| ENR (* enum references *)
+	| ABR (* abstract references *)
+	| TDR (* typedef references *)
+	(* Field references *)
+	| AFR (* anon field references *)
+	(* Own module type definitions *)
+	| CLD (* class definition *)
+	| END (* enum definition *)
+	| ABD (* abstract definition *)
+	| TDD (* typedef definition *)
+	| EOT (* end of module types *)
+	(* Field references *)
+	| EFR (* enum field references *)
+	| CFR (* class field references *)
+	(* Own field definitions *)
+	| CFD (* class fields *)
+	| EFD (* enum fields *)
+	| AFD (* abstract fields *)
+	| EOF (* end of fields *)
+	| EXD (* class field expressions *)
+	| EOM (* end of module *)
+
+type cached_chunk = chunk_kind * bytes
+type cached_chunks = cached_chunk list
+
+type module_cache = {
+	mc_path : path;
+	mc_id : int;
+	mc_chunks : cached_chunks;
+	mc_extra : module_def_extra;
+}
+
+let string_of_chunk_kind = function
+	| STR -> "STR"
+	| DOC -> "DOC"
+	| MDF -> "MDF"
+	| MTF -> "MTF"
+	| MDR -> "MDR"
+	| CLR -> "CLR"
+	| ENR -> "ENR"
+	| ABR -> "ABR"
+	| TDR -> "TDR"
+	| AFR -> "AFR"
+	| EFR -> "EFR"
+	| CFR -> "CFR"
+	| CLD -> "CLD"
+	| END -> "END"
+	| ABD -> "ABD"
+	| TDD -> "TDD"
+	| EOT -> "EOT"
+	| CFD -> "CFD"
+	| EFD -> "EFD"
+	| AFD -> "AFD"
+	| EOF -> "EOF"
+	| EXD -> "EXD"
+	| EOM -> "EOM"
+
+let chunk_kind_of_string = function
+	| "STR" -> STR
+	| "DOC" -> DOC
+	| "MDF" -> MDF
+	| "MTF" -> MTF
+	| "MDR" -> MDR
+	| "CLR" -> CLR
+	| "ENR" -> ENR
+	| "ABR" -> ABR
+	| "TDR" -> TDR
+	| "AFR" -> AFR
+	| "EFR" -> EFR
+	| "CFR" -> CFR
+	| "CLD" -> CLD
+	| "END" -> END
+	| "ABD" -> ABD
+	| "TDD" -> TDD
+	| "EOT" -> EOT
+	| "CFD" -> CFD
+	| "EFD" -> EFD
+	| "AFD" -> AFD
+	| "EOF" -> EOF
+	| "EXD" -> EXD
+	| "EOM" -> EOM
+	| name -> raise (HxbFailure ("Invalid chunk name: " ^ name))
+
+let error (s : string) =
+	Printf.eprintf "[error] %s\n" s;
+	raise (HxbFailure s)
+
+let hxb_version = 1
+
+let write_header ch =
+	IO.nwrite_string ch "hxb";
+	IO.write_byte ch hxb_version
+
+let write_chunk_prefix kind length ch =
+	IO.nwrite ch (Bytes.unsafe_of_string (string_of_chunk_kind kind));
+	IO.write_real_i32 ch (Int32.of_int length)

src/compiler/hxb/hxbLib.ml

@@ -0,0 +1,63 @@
+open Globals
+open Common
+open ExtString
+
+class hxb_library file_path = object(self)
+	inherit abstract_hxb_lib
+	val zip = lazy (Zip.open_in file_path)
+
+	val mutable cached_files = []
+	val modules = Hashtbl.create 0
+	val mutable closed = false
+	val mutable loaded = false
+
+	method load =
+		if not loaded then begin
+			loaded <- true;
+			let close = Timer.timer ["hxblib";"read"] in
+			List.iter (function
+				| ({ Zip.is_directory = false; Zip.filename = filename } as entry) when String.ends_with filename ".hxb" ->
+					let pack = String.nsplit filename "/" in
+					begin match List.rev pack with
+						| [] -> ()
+						| name :: pack ->
+							let name = String.sub name 0 (String.length name - 4) in
+							let pack = List.rev pack in
+							Hashtbl.add modules (pack,name) (filename,entry);
+						end
+				| _ -> ()
+			) (Zip.entries (Lazy.force zip));
+			close();
+		end
+
+	method get_bytes (target : string) (path : path) =
+		try
+			let path = (target :: fst path,snd path) in
+			let (filename,entry) = Hashtbl.find modules path in
+			let close = Timer.timer ["hxblib";"get bytes"] in
+			let zip = Lazy.force zip in
+			let data = Zip.read_entry zip entry in
+			close();
+			Some (Bytes.unsafe_of_string data)
+		with Not_found ->
+			None
+
+	method close =
+		if not closed then begin
+			closed <- true;
+			Zip.close_in (Lazy.force zip)
+		end
+
+	method get_file_path = file_path
+end
+
+
+let create_hxb_lib com file_path =
+	let file = if Sys.file_exists file_path then
+		file_path
+	else try
+		Common.find_file com file_path
+	with Not_found ->
+		failwith ("hxb lib " ^ file_path ^ " not found")
+	in
+	new hxb_library file

src/compiler/hxb/hxbReader.ml

@@ -0,0 +1,2000 @@
+open Globals
+open Ast
+open Type
+open HxbData
+open HxbReaderApi
+
+type field_reader_context = {
+	t_pool : Type.t Array.t;
+	pos : pos ref;
+	vars : tvar Array.t;
+	mutable tthis : Type.t option;
+}
+
+let create_field_reader_context p ts vars tthis = {
+	t_pool = ts;
+	pos = ref p;
+	vars = vars;
+	tthis = tthis;
+}
+
+type hxb_reader_stats = {
+	modules_fully_restored : int ref;
+	modules_partially_restored : int ref;
+}
+
+let create_hxb_reader_stats () = {
+	modules_fully_restored = ref 0;
+	modules_partially_restored = ref 0;
+}
+
+module ClassFieldInfo = struct
+	type t = {
+		type_parameters : typed_type_param array;
+	}
+
+	let create params = {
+		type_parameters = params;
+	}
+end
+
+module ClassFieldInfos = struct
+	type t = {
+		infos : ClassFieldInfo.t DynArray.t;
+	}
+
+	let meta = Meta.HxbId
+
+	let create () = {
+		infos = DynArray.create ()
+	}
+
+	let get infos cf =
+		let _,_,p = Meta.get meta cf.cf_meta in
+		DynArray.get infos.infos p.pmin
+
+	let unset infos cf =
+		cf.cf_meta <- Meta.remove meta cf.cf_meta
+
+	let set infos info cf =
+		let index = DynArray.length infos.infos in
+		DynArray.add infos.infos info;
+		cf.cf_meta <- (meta,[],{null_pos with pmin = index}) :: cf.cf_meta
+end
+
+module BytesWithPosition = struct
+	type t = {
+		bytes : bytes;
+		mutable pos : int;
+	}
+
+	let create bytes = {
+		bytes;
+		pos = 0;
+	}
+
+	let read_byte b =
+		let i = Bytes.unsafe_get b.bytes b.pos in
+		b.pos <- b.pos + 1;
+		int_of_char i
+
+	let read_bytes b length =
+		let out = Bytes.create length in
+		Bytes.blit b.bytes b.pos out 0 length;
+		b.pos <- b.pos + length;
+		out
+
+	let read_i16 i =
+		let ch2 = read_byte i in
+		let ch1 = read_byte i in
+		let n = ch1 lor (ch2 lsl 8) in
+		if ch2 land 128 <> 0 then
+			n - 65536
+		else
+			n
+
+	let read_real_i32 ch =
+		let ch1 = read_byte ch in
+		let ch2 = read_byte ch in
+		let ch3 = read_byte ch in
+		let base = Int32.of_int (ch1 lor (ch2 lsl 8) lor (ch3 lsl 16)) in
+		let big = Int32.shift_left (Int32.of_int (read_byte ch)) 24 in
+		Int32.logor base big
+
+		let read_i64 ch =
+			let big = Int64.of_int32 (read_real_i32 ch) in
+			let ch4 = read_byte ch in
+			let ch3 = read_byte ch in
+			let ch2 = read_byte ch in
+			let ch1 = read_byte ch in
+			let base = Int64.of_int (ch1 lor (ch2 lsl 8) lor (ch3 lsl 16)) in
+			let small = Int64.logor base (Int64.shift_left (Int64.of_int ch4) 24) in
+			Int64.logor (Int64.shift_left big 32) small
+
+	let read_double ch =
+		Int64.float_of_bits (read_i64 ch)
+end
+
+open BytesWithPosition
+
+let rec read_uleb128 ch =
+	let b = read_byte ch in
+	if b >= 0x80 then
+		(b land 0x7F) lor ((read_uleb128 ch) lsl 7)
+	else
+		b
+
+let read_leb128 ch =
+	let rec read acc shift =
+		let b = read_byte ch in
+		let acc = ((b land 0x7F) lsl shift) lor acc in
+		if b >= 0x80 then
+			read acc (shift + 7)
+		else
+			(b, acc, shift + 7)
+	in
+	let last, acc, shift = read 0 0 in
+	let res = (if (last land 0x40) <> 0 then
+		acc lor ((lnot 0) lsl shift)
+	else
+		acc) in
+	res
+
+let dump_stats name stats =
+	print_endline (Printf.sprintf "hxb_reader stats for %s" name);
+	print_endline (Printf.sprintf "  modules partially restored: %i" (!(stats.modules_fully_restored) - !(stats.modules_partially_restored)));
+	print_endline (Printf.sprintf "  modules fully restored: %i" !(stats.modules_fully_restored));
+
+class hxb_reader
+	(mpath : path)
+	(stats : hxb_reader_stats)
+= object(self)
+	val mutable api = Obj.magic ""
+	val mutable current_module = null_module
+
+	val mutable ch = BytesWithPosition.create (Bytes.create 0)
+	val mutable string_pool = Array.make 0 ""
+	val mutable doc_pool = Array.make 0 ""
+
+	val mutable classes = Array.make 0 null_class
+	val mutable abstracts = Array.make 0 null_abstract
+	val mutable enums = Array.make 0 null_enum
+	val mutable typedefs = Array.make 0 null_typedef
+	val mutable anons = Array.make 0 null_tanon
+	val mutable anon_fields = Array.make 0 null_field
+	val mutable tmonos = Array.make 0 (mk_mono())
+	val mutable class_fields = Array.make 0 null_field
+	val mutable enum_fields = Array.make 0 null_enum_field
+
+	val mutable type_type_parameters = Array.make 0 (mk_type_param null_class TPHType None None)
+	val mutable field_type_parameters = Array.make 0 (mk_type_param null_class TPHMethod None None)
+	val mutable local_type_parameters = Array.make 0 (mk_type_param null_class TPHLocal None None)
+
+	val mutable field_type_parameter_offset = 0
+	val empty_anon = mk_anon (ref Closed)
+
+	method resolve_type pack mname tname =
+		try
+			api#resolve_type pack mname tname
+		with Not_found ->
+			dump_backtrace();
+			error (Printf.sprintf "[HXB] [%s] Cannot resolve type %s" (s_type_path current_module.m_path) (s_type_path ((pack @ [mname]),tname)))
+
+	(* Primitives *)
+
+	method read_i32 =
+		read_real_i32 ch
+
+	method read_i16 =
+		read_i16 ch
+
+	method read_f64 =
+		read_double ch
+
+	method read_bool =
+		read_byte ch <> 0
+
+	method read_from_string_pool pool =
+		pool.(read_uleb128 ch)
+
+	method read_string =
+		self#read_from_string_pool string_pool
+
+	method read_raw_string =
+		let l = read_uleb128 ch in
+		Bytes.unsafe_to_string (read_bytes ch l)
+
+	(* Basic compounds *)
+
+	method read_list : 'a . (unit -> 'a) -> 'a list = fun f ->
+		let l = read_uleb128 ch in
+		List.init l (fun _ -> f ())
+
+	method read_option : 'a . (unit -> 'a) -> 'a option = fun f ->
+		match read_byte ch with
+		| 0 ->
+			None
+		| _ ->
+			Some (f())
+
+	method read_path =
+		let pack = self#read_list (fun () -> self#read_string) in
+		let name = self#read_string in
+		(pack,name)
+
+	method read_full_path =
+		let pack = self#read_list (fun () -> self#read_string) in
+		let mname = self#read_string in
+		let tname = self#read_string in
+		(pack,mname,tname)
+
+	method read_documentation =
+		let doc_own = self#read_option (fun () ->
+			self#read_from_string_pool doc_pool
+		) in
+		let doc_inherited = self#read_list (fun () ->
+			self#read_from_string_pool doc_pool
+		) in
+		{doc_own;doc_inherited}
+
+	method read_pos =
+		let file = self#read_string in
+		let min = read_leb128 ch in
+		let max = read_leb128 ch in
+		let pos = {
+			pfile = file;
+			pmin = min;
+			pmax = max;
+		} in
+		pos
+
+	method read_pos_pair =
+		let file = self#read_string in
+		let min1 = read_leb128 ch in
+		let max1 = read_leb128 ch in
+		let min2 = read_leb128 ch in
+		let max2 = read_leb128 ch in
+		let pos1 = {
+			pfile = file;
+			pmin = min1;
+			pmax = max1;
+		} in
+		let pos2 = {
+			pos1 with
+			pmin = pos1.pmin + min2;
+			pmax = pos1.pmin + max2;
+		} in
+		pos1,pos2
+
+	method read_metadata_entry : metadata_entry =
+		let name = self#read_string in
+		let p = self#read_pos in
+		let el = self#read_list (fun () -> self#read_expr) in
+		(Meta.from_string name,el,p)
+
+	method read_metadata =
+		self#read_list (fun () -> self#read_metadata_entry)
+
+	(* References *)
+
+	method read_class_ref =
+		classes.(read_uleb128 ch)
+
+	method read_abstract_ref =
+		abstracts.(read_uleb128 ch)
+
+	method read_enum_ref =
+		enums.(read_uleb128 ch)
+
+	method read_typedef_ref =
+		typedefs.(read_uleb128 ch)
+
+	method read_field_ref =
+		class_fields.(read_uleb128 ch)
+
+	method read_enum_field_ref =
+		enum_fields.(read_uleb128 ch)
+
+	method read_anon_ref =
+		match read_byte ch with
+		| 0 ->
+			anons.(read_uleb128 ch)
+		| 1 ->
+			let an = anons.(read_uleb128 ch) in
+			self#read_anon an
+		| _ ->
+			assert false
+
+	method read_anon_field_ref =
+		match read_byte ch with
+		| 0 ->
+			anon_fields.(read_uleb128 ch)
+		| 1 ->
+			let cf = anon_fields.(read_uleb128 ch) in
+			self#read_class_field_and_overloads_data cf;
+			cf
+		| _ ->
+			assert false
+
+	(* Expr *)
+
+	method get_binop i = match i with
+		| 0 -> OpAdd
+		| 1 -> OpMult
+		| 2 -> OpDiv
+		| 3 -> OpSub
+		| 4 -> OpAssign
+		| 5 -> OpEq
+		| 6 -> OpNotEq
+		| 7 -> OpGt
+		| 8 -> OpGte
+		| 9 -> OpLt
+		| 10 -> OpLte
+		| 11 -> OpAnd
+		| 12 -> OpOr
+		| 13 -> OpXor
+		| 14 -> OpBoolAnd
+		| 15 -> OpBoolOr
+		| 16 -> OpShl
+		| 17 -> OpShr
+		| 18 -> OpUShr
+		| 19 -> OpMod
+		| 20 -> OpInterval
+		| 21 -> OpArrow
+		| 22 -> OpIn
+		| 23 -> OpNullCoal
+		| _ -> OpAssignOp (self#get_binop (i - 30))
+
+	method get_unop i = match i with
+		| 0 -> Increment,Prefix
+		| 1 -> Decrement,Prefix
+		| 2 -> Not,Prefix
+		| 3 -> Neg,Prefix
+		| 4 -> NegBits,Prefix
+		| 5 -> Spread,Prefix
+		| 6 -> Increment,Postfix
+		| 7 -> Decrement,Postfix
+		| 8 -> Not,Postfix
+		| 9 -> Neg,Postfix
+		| 10 -> NegBits,Postfix
+		| 11 -> Spread,Postfix
+		| _ -> assert false
+
+	method read_placed_name =
+		let s = self#read_string in
+		let p = self#read_pos in
+		(s,p)
+
+	method read_type_path =
+		let pack = self#read_list (fun () -> self#read_string) in
+		let name = self#read_string in
+		let tparams = self#read_list (fun () -> self#read_type_param_or_const) in
+		let tsub = self#read_option (fun () -> self#read_string) in
+		{
+			tpackage = pack;
+			tname = name;
+			tparams = tparams;
+			tsub = tsub;
+		}
+
+	method read_placed_type_path =
+		let tp = self#read_type_path in
+		let pfull,ppath = self#read_pos_pair in
+		{
+			path = tp;
+			pos_full = pfull;
+			pos_path = ppath;
+		}
+
+	method read_type_param =
+		let pn = self#read_placed_name in
+		let ttp = self#read_list (fun () -> self#read_type_param) in
+		let tho = self#read_option (fun () -> self#read_type_hint) in
+		let def = self#read_option (fun () -> self#read_type_hint) in
+		let meta = self#read_metadata in
+		{
+			tp_name = pn;
+			tp_params = ttp;
+			tp_constraints = tho;
+			tp_meta = meta;
+			tp_default = def;
+		}
+
+	method read_type_param_or_const =
+		match read_byte ch with
+		| 0 -> TPType (self#read_type_hint)
+		| 1 -> TPExpr (self#read_expr)
+		| _ -> assert false
+
+	method read_func_arg =
+		let pn = self#read_placed_name in
+		let b = self#read_bool in
+		let meta = self#read_metadata in
+		let tho = self#read_option (fun () -> self#read_type_hint) in
+		let eo = self#read_option (fun () -> self#read_expr) in
+		(pn,b,meta,tho,eo)
+
+	method read_func =
+		let params = self#read_list (fun () -> self#read_type_param) in
+		let args = self#read_list (fun () -> self#read_func_arg) in
+		let tho = self#read_option (fun () -> self#read_type_hint) in
+		let eo = self#read_option (fun () -> self#read_expr) in
+		{
+			f_params = params;
+			f_args = args;
+			f_type = tho;
+			f_expr = eo;
+		}
+
+	method read_complex_type =
+		match read_byte ch with
+		| 0 -> CTPath (self#read_placed_type_path)
+		| 1 ->
+			let thl = self#read_list (fun () -> self#read_type_hint) in
+			let th = self#read_type_hint in
+			CTFunction(thl,th)
+		| 2 -> CTAnonymous (self#read_list (fun () -> self#read_cfield))
+		| 3 -> CTParent (self#read_type_hint)
+		| 4 ->
+			let ptp = self#read_list (fun () -> self#read_placed_type_path) in
+			let cffl = self#read_list (fun () -> self#read_cfield) in
+			CTExtend(ptp,cffl)
+		| 5 -> CTOptional (self#read_type_hint)
+		| 6 ->
+			let pn = self#read_placed_name in
+			let th = self#read_type_hint in
+			CTNamed(pn,th)
+		| 7 -> CTIntersection (self#read_list (fun () -> self#read_type_hint))
+		| _ -> assert false
+
+	method read_type_hint =
+		let ct = self#read_complex_type in
+		let p = self#read_pos in
+		(ct,p)
+
+	method read_access =
+		match read_byte ch with
+		| 0 -> APublic
+		| 1 -> APrivate
+		| 2 -> AStatic
+		| 3 -> AOverride
+		| 4 -> ADynamic
+		| 5 -> AInline
+		| 6 -> AMacro
+		| 7 -> AFinal
+		| 8 -> AExtern
+		| 9 -> AAbstract
+		| 10 -> AOverload
+		| 11 -> AEnum
+		| _ -> assert false
+
+	method read_placed_access =
+		let ac = self#read_access in
+		let p = self#read_pos in
+		(ac,p)
+
+	method read_cfield_kind =
+		match read_byte ch with
+		| 0 ->
+			let tho = self#read_option (fun () -> self#read_type_hint) in
+			let eo = self#read_option (fun () -> self#read_expr) in
+			FVar(tho,eo)
+		| 1 -> FFun (self#read_func)
+		| 2 ->
+			let pn1 = self#read_placed_name in
+			let pn2 = self#read_placed_name in
+			let tho = self#read_option (fun () -> self#read_type_hint) in
+			let eo = self#read_option (fun () -> self#read_expr) in
+			FProp(pn1,pn2,tho,eo)
+		| _ -> assert false
+
+	method read_cfield =
+		let pn = self#read_placed_name in
+		let doc = self#read_option (fun () -> self#read_documentation) in
+		let pos = self#read_pos in
+		let meta = self#read_metadata in
+		let access = self#read_list (fun () -> self#read_placed_access) in
+		let kind = self#read_cfield_kind in
+		{
+			cff_name = pn;
+			cff_doc = doc;
+			cff_pos = pos;
+			cff_meta = meta;
+			cff_access = access;
+			cff_kind = kind;
+		}
+
+	method read_expr =
+		let p = self#read_pos in
+		let e = match read_byte ch with
+		| 0 ->
+			let s = self#read_string in
+			let suffix = self#read_option (fun () -> self#read_string) in
+			EConst (Int (s, suffix))
+		| 1 ->
+			let s = self#read_string in
+			let suffix = self#read_option (fun () -> self#read_string) in
+			EConst (Float (s, suffix))
+		| 2 ->
+			let s = self#read_string in
+			let qs = begin match read_byte ch with
+			| 0 -> SDoubleQuotes
+			| 1 -> SSingleQuotes
+			| _ -> assert false
+			end in
+			EConst (String (s,qs))
+		| 3 ->
+			EConst (Ident (self#read_string))
+		| 4 ->
+			let s1 = self#read_string in
+			let s2 = self#read_string in
+			EConst (Regexp(s1,s2))
+		| 5 ->
+			let e1 = self#read_expr in
+			let e2 = self#read_expr in
+			EArray(e1,e2)
+		| 6 ->
+			let op = self#get_binop (read_byte ch) in
+			let e1 = self#read_expr in
+			let e2 = self#read_expr in
+			EBinop(op,e1,e2)
+		| 7 ->
+			let e = self#read_expr in
+			let s = self#read_string in
+			let kind = begin match read_byte ch with
+			| 0 -> EFNormal
+			| 1 -> EFSafe
+			| _ -> assert false
+			end in
+			EField(e,s,kind)
+		| 8 ->
+			EParenthesis (self#read_expr)
+		| 9 ->
+			let fields = self#read_list (fun () ->
+				let n = self#read_string in
+				let p = self#read_pos in
+				let qs = begin match read_byte ch with
+				| 0 -> NoQuotes
+				| 1 -> DoubleQuotes
+				| _ -> assert false
+				end in
+				let e = self#read_expr in
+				((n,p,qs),e)
+			) in
+			EObjectDecl fields
+		| 10 ->
+			let el = self#read_list (fun () -> self#read_expr) in
+			EArrayDecl el
+		| 11 ->
+			let e = self#read_expr in
+			let el = self#read_list (fun () -> self#read_expr) in
+			ECall(e,el)
+		| 12 ->
+			let ptp = self#read_placed_type_path in
+			let el = self#read_list (fun () -> self#read_expr) in
+			ENew(ptp,el)
+		| 13 ->
+			let (op,flag) = self#get_unop (read_byte ch) in
+			let e = self#read_expr in
+			EUnop(op,flag,e)
+		| 14 ->
+			let vl = self#read_list (fun () ->
+				let name = self#read_placed_name in
+				let final = self#read_bool in
+				let static = self#read_bool in
+				let t = self#read_option (fun () -> self#read_type_hint) in
+				let expr = self#read_option (fun () -> self#read_expr) in
+				let meta = self#read_metadata in
+				{
+					ev_name = name;
+					ev_final = final;
+					ev_static = static;
+					ev_type = t;
+					ev_expr = expr;
+					ev_meta = meta;
+				}
+			) in
+			EVars vl
+		| 15 ->
+			let fk = begin match read_byte ch with
+			| 0 -> FKAnonymous
+			| 1 ->
+				let pn = self#read_placed_name in
+				let b = self#read_bool in
+				FKNamed(pn,b)
+			| 2 -> FKArrow
+			| _ -> assert false end in
+			let f = self#read_func in
+			EFunction(fk,f)
+		| 16 ->
+			EBlock (self#read_list (fun () -> self#read_expr))
+		| 17 ->
+			let e1 = self#read_expr in
+			let e2 = self#read_expr in
+			EFor(e1,e2)
+		| 18 ->
+			let e1 = self#read_expr in
+			let e2 = self#read_expr in
+			EIf(e1,e2,None)
+		| 19 ->
+			let e1 = self#read_expr in
+			let e2 = self#read_expr in
+			let e3 = self#read_expr in
+			EIf(e1,e2,Some e3)
+		| 20 ->
+			let e1 = self#read_expr in
+			let e2 = self#read_expr in
+			EWhile(e1,e2,NormalWhile)
+		| 21 ->
+			let e1 = self#read_expr in
+			let e2 = self#read_expr in
+			EWhile(e1,e2,DoWhile)
+		| 22 ->
+			let e1 = self#read_expr in
+			let cases = self#read_list (fun () ->
+				let el = self#read_list (fun () -> self#read_expr) in
+				let eg = self#read_option (fun () -> self#read_expr) in
+				let eo = self#read_option (fun () -> self#read_expr) in
+				let p = self#read_pos in
+				(el,eg,eo,p)
+			) in
+			let def = self#read_option (fun () ->
+				let eo = self#read_option (fun () -> self#read_expr) in
+				let p = self#read_pos in
+				(eo,p)
+			) in
+			ESwitch(e1,cases,def)
+		| 23 ->
+			let e1 = self#read_expr in
+			let catches = self#read_list (fun () ->
+				let pn = self#read_placed_name in
+				let th = self#read_option (fun () -> self#read_type_hint) in
+				let e = self#read_expr in
+				let p = self#read_pos in
+				(pn,th,e,p)
+			) in
+			ETry(e1,catches)
+		| 24 -> EReturn None
+		| 25 -> EReturn (Some (self#read_expr))
+		| 26 -> EBreak
+		| 27 -> EContinue
+		| 28 -> EUntyped (self#read_expr)
+		| 29 -> EThrow (self#read_expr)
+		| 30 -> ECast ((self#read_expr),None)
+		| 31 ->
+			let e1 = self#read_expr in
+			let th = self#read_type_hint in
+			ECast(e1,Some th)
+		| 32 ->
+			let e1 = self#read_expr in
+			let th = self#read_type_hint in
+			EIs(e1,th)
+		| 33 ->
+			let e1 = self#read_expr in
+			let dk = begin match read_byte ch with
+			| 0 -> DKCall
+			| 1 -> DKDot
+			| 2 -> DKStructure
+			| 3 -> DKMarked
+			| 4 -> DKPattern (self#read_bool)
+			| _ -> assert false end in
+			EDisplay(e1,dk)
+		| 34 ->
+			let e1 = self#read_expr in
+			let e2 = self#read_expr in
+			let e3 = self#read_expr in
+			ETernary(e1,e2,e3)
+		| 35 ->
+			let e1 = self#read_expr in
+			let th = self#read_type_hint in
+			ECheckType(e1,th)
+		| 36 ->
+			let m = self#read_metadata_entry in
+			let e = self#read_expr in
+			EMeta(m,e)
+		| _ -> assert false
+		in
+		(e,p)
+
+	(* Type instances *)
+
+	method resolve_ttp_ref = function
+		| 1 ->
+			let i = read_uleb128 ch in
+			(type_type_parameters.(i))
+		| 2 ->
+			let i = read_uleb128 ch in
+			(field_type_parameters.(i))
+		| 3 ->
+			let k = read_uleb128 ch in
+			local_type_parameters.(k)
+		| _ ->
+			die "" __LOC__
+
+	method read_type_instance =
+		let read_fun_arg () =
+			let name = self#read_string in
+			let opt = self#read_bool in
+			let t = self#read_type_instance in
+			(name,opt,t)
+		in
+		match (read_byte ch) with
+		| 0 ->
+			let i = read_uleb128 ch in
+			tmonos.(i)
+		| 1 ->
+			let i = read_uleb128 ch in
+			(type_type_parameters.(i)).ttp_type
+		| 2 ->
+			let i = read_uleb128 ch in
+			(field_type_parameters.(i)).ttp_type
+		| 3 ->
+			let k = read_uleb128 ch in
+			local_type_parameters.(k).ttp_type
+		| 4 ->
+			t_dynamic
+		| 10 ->
+			let c = self#read_class_ref in
+			c.cl_type
+		| 11 ->
+			let en = self#read_enum_ref in
+			en.e_type
+		| 12 ->
+			let a = self#read_abstract_ref in
+			TType(abstract_module_type a [],[])
+		| 13 ->
+			let e = self#read_expr in
+			let c = {null_class with cl_kind = KExpr e; cl_module = current_module } in
+			TInst(c, [])
+		| 20 ->
+			TFun([],api#basic_types.tvoid)
+		| 21 ->
+			let arg1 = read_fun_arg () in
+			TFun([arg1],api#basic_types.tvoid)
+		| 22 ->
+			let arg1 = read_fun_arg () in
+			let arg2 = read_fun_arg () in
+			TFun([arg1;arg2],api#basic_types.tvoid)
+		| 23 ->
+			let arg1 = read_fun_arg () in
+			let arg2 = read_fun_arg () in
+			let arg3 = read_fun_arg () in
+			TFun([arg1;arg2;arg3],api#basic_types.tvoid)
+		| 24 ->
+			let arg1 = read_fun_arg () in
+			let arg2 = read_fun_arg () in
+			let arg3 = read_fun_arg () in
+			let arg4 = read_fun_arg () in
+			TFun([arg1;arg2;arg3;arg4],api#basic_types.tvoid)
+		| 29 ->
+			let args = self#read_list read_fun_arg in
+			TFun(args,api#basic_types.tvoid)
+		| 30 ->
+			let ret = self#read_type_instance in
+			TFun([],ret)
+		| 31 ->
+			let arg1 = read_fun_arg () in
+			let ret = self#read_type_instance in
+			TFun([arg1],ret)
+		| 32 ->
+			let arg1 = read_fun_arg () in
+			let arg2 = read_fun_arg () in
+			let ret = self#read_type_instance in
+			TFun([arg1;arg2],ret)
+		| 33 ->
+			let arg1 = read_fun_arg () in
+			let arg2 = read_fun_arg () in
+			let arg3 = read_fun_arg () in
+			let ret = self#read_type_instance in
+			TFun([arg1;arg2;arg3],ret)
+		| 34 ->
+			let arg1 = read_fun_arg () in
+			let arg2 = read_fun_arg () in
+			let arg3 = read_fun_arg () in
+			let arg4 = read_fun_arg () in
+			let ret = self#read_type_instance in
+			TFun([arg1;arg2;arg3;arg4],ret)
+		| 39 ->
+			let args = self#read_list read_fun_arg in
+			let ret = self#read_type_instance in
+			TFun(args,ret)
+		| 40 ->
+			let c = self#read_class_ref in
+			TInst(c,[])
+		| 41 ->
+			let c = self#read_class_ref in
+			let t1 = self#read_type_instance in
+			TInst(c,[t1])
+		| 42 ->
+			let c = self#read_class_ref in
+			let t1 = self#read_type_instance in
+			let t2 = self#read_type_instance in
+			TInst(c,[t1;t2])
+		| 49 ->
+			let c = self#read_class_ref in
+			let tl = self#read_types in
+			TInst(c,tl)
+		| 50 ->
+			let en = self#read_enum_ref in
+			TEnum(en,[])
+		| 51 ->
+			let en = self#read_enum_ref in
+			let t1 = self#read_type_instance in
+			TEnum(en,[t1])
+		| 52 ->
+			let en = self#read_enum_ref in
+			let t1 = self#read_type_instance in
+			let t2 = self#read_type_instance in
+			TEnum(en,[t1;t2])
+		| 59 ->
+			let e = self#read_enum_ref in
+			let tl = self#read_types in
+			TEnum(e,tl)
+		| 60 ->
+			let td = self#read_typedef_ref in
+			TType(td,[])
+		| 61 ->
+			let td = self#read_typedef_ref in
+			let t1 = self#read_type_instance in
+			TType(td,[t1])
+		| 62 ->
+			let td = self#read_typedef_ref in
+			let t1 = self#read_type_instance in
+			let t2 = self#read_type_instance in
+			TType(td,[t1;t2])
+		| 69 ->
+			let t = self#read_typedef_ref in
+			let tl = self#read_types in
+			TType(t,tl)
+		| 70 ->
+			let a = self#read_abstract_ref in
+			TAbstract(a,[])
+		| 71 ->
+			let a = self#read_abstract_ref in
+			let t1 = self#read_type_instance in
+			TAbstract(a,[t1])
+		| 72 ->
+			let a = self#read_abstract_ref in
+			let t1 = self#read_type_instance in
+			let t2 = self#read_type_instance in
+			TAbstract(a,[t1;t2])
+		| 79 ->
+			let a = self#read_abstract_ref in
+			let tl = self#read_types in
+			TAbstract(a,tl)
+		| 80 ->
+			empty_anon
+		| 81 ->
+			TAnon self#read_anon_ref
+		| 89 ->
+			TDynamic (Some self#read_type_instance)
+		| 100 ->
+			api#basic_types.tvoid
+		| 101 ->
+			api#basic_types.tint
+		| 102 ->
+			api#basic_types.tfloat
+		| 103 ->
+			api#basic_types.tbool
+		| 104 ->
+			api#basic_types.tstring
+		| i ->
+			error (Printf.sprintf "Bad type instance id: %i" i)
+
+	method read_types =
+		self#read_list (fun () -> self#read_type_instance)
+
+	method read_type_parameters_forward =
+		let length = read_uleb128 ch in
+		Array.init length (fun _ ->
+			let path = self#read_path in
+			let pos = self#read_pos in
+			let host = match read_byte ch with
+				| 0 -> TPHType
+				| 1 -> TPHConstructor
+				| 2 -> TPHMethod
+				| 3 -> TPHEnumConstructor
+				| 4 -> TPHAnonField
+				| 5 -> TPHLocal
+				| i -> die (Printf.sprintf "Invalid type paramter host: %i" i) __LOC__
+			in
+			let c = mk_class current_module path pos pos in
+			mk_type_param c host None None
+		)
+
+	method read_type_parameters_data (a : typed_type_param array) =
+		Array.iter (fun ttp ->
+			let meta = self#read_metadata in
+			let constraints = self#read_types in
+			let def = self#read_option (fun () -> self#read_type_instance) in
+			let c = ttp.ttp_class in
+			ttp.ttp_default <- def;
+			ttp.ttp_constraints <- Some (Lazy.from_val constraints);
+			c.cl_meta <- meta;
+		) a
+
+	(* Fields *)
+
+	method read_field_kind = match read_byte ch with
+		| 0 -> Method MethNormal
+		| 1 -> Method MethInline
+		| 2 -> Method MethDynamic
+		| 3 -> Method MethMacro
+		| 10 -> Var {v_read = AccNormal;v_write = AccNormal}
+		| 11 -> Var {v_read = AccNormal;v_write = AccNo}
+		| 12 -> Var {v_read = AccNormal;v_write = AccNever}
+		| 13 -> Var {v_read = AccNormal;v_write = AccCtor}
+		| 14 -> Var {v_read = AccNormal;v_write = AccCall}
+		| 20 -> Var {v_read = AccInline;v_write = AccNever}
+		| 30 -> Var {v_read = AccCall;v_write = AccNormal}
+		| 31 -> Var {v_read = AccCall;v_write = AccNo}
+		| 32 -> Var {v_read = AccCall;v_write = AccNever}
+		| 33 -> Var {v_read = AccCall;v_write = AccCtor}
+		| 34 -> Var {v_read = AccCall;v_write = AccCall}
+		| 100 ->
+			let f = function
+				| 0 -> AccNormal
+				| 1 -> AccNo
+				| 2 -> AccNever
+				| 3 -> AccCtor
+				| 4 -> AccCall
+				| 5 -> AccInline
+				| 6 ->
+					let s = self#read_string in
+					let so = self#read_option (fun () -> self#read_string) in
+					AccRequire(s,so)
+				| i ->
+					error (Printf.sprintf "Bad accessor kind: %i" i)
+			in
+			let r = f (read_byte ch) in
+			let w = f (read_byte ch) in
+			Var {v_read = r;v_write = w}
+		| i ->
+			error (Printf.sprintf "Bad field kind: %i" i)
+
+	method read_var_kind =
+		match read_byte ch with
+			| 0 -> VUser TVOLocalVariable
+			| 1 -> VUser TVOArgument
+			| 2 -> VUser TVOForVariable
+			| 3 -> VUser TVOPatternVariable
+			| 4 -> VUser TVOCatchVariable
+			| 5 -> VUser TVOLocalFunction
+			| 6 -> VGenerated
+			| 7 -> VInlined
+			| 8 -> VInlinedConstructorVariable
+			| 9 -> VExtractorVariable
+			| 10 -> VAbstractThis
+			| _ -> assert false
+
+	method read_var =
+		let id = read_uleb128 ch in
+		let name = self#read_string in
+		let kind = self#read_var_kind in
+		let flags = read_uleb128 ch in
+		let meta = self#read_metadata in
+		let pos = self#read_pos in
+		let v = {
+			v_id = api#get_var_id id;
+			v_name = name;
+			v_type = t_dynamic;
+			v_kind = kind;
+			v_meta = meta;
+			v_pos = pos;
+			v_extra = None;
+			v_flags = flags;
+		} in
+		v
+
+	method read_texpr fctx =
+
+		let declare_local () =
+			let v = fctx.vars.(read_uleb128 ch) in
+			v.v_extra <- self#read_option (fun () ->
+				let params = self#read_list (fun () ->
+					let i = read_uleb128 ch in
+					local_type_parameters.(i)
+				) in
+				let vexpr = self#read_option (fun () -> self#read_texpr fctx) in
+				{
+					v_params = params;
+					v_expr = vexpr;
+				};
+			);
+			v.v_type <- self#read_type_instance;
+			v
+		in
+		let update_pmin () =
+			fctx.pos := {!(fctx.pos) with pmin = read_leb128 ch};
+		in
+		let update_pmax () =
+			fctx.pos := {!(fctx.pos) with pmax = read_leb128 ch};
+		in
+		let update_pminmax () =
+			let pmin = read_leb128 ch in
+			let pmax = read_leb128 ch in
+			fctx.pos := {!(fctx.pos) with pmin; pmax};
+		in
+		let update_p () =
+			fctx.pos := self#read_pos;
+		in
+		let read_relpos () =
+			begin match read_byte ch with
+				| 0 ->
+					()
+				| 1 ->
+					update_pmin ()
+				| 2 ->
+					update_pmax ()
+				| 3 ->
+					update_pminmax ()
+				| 4 ->
+					update_p ()
+				| _ ->
+					assert false
+			end;
+			!(fctx.pos)
+		in
+		let rec loop () =
+			let loop2 () =
+				match read_byte ch with
+					(* values 0-19 *)
+					| 0 -> TConst TNull,None
+					| 1 -> TConst TThis,fctx.tthis
+					| 2 -> TConst TSuper,None
+					| 3 -> TConst (TBool false),(Some api#basic_types.tbool)
+					| 4 -> TConst (TBool true),(Some api#basic_types.tbool)
+					| 5 -> TConst (TInt self#read_i32),(Some api#basic_types.tint)
+					| 6 -> TConst (TFloat self#read_string),(Some api#basic_types.tfloat)
+					| 7 -> TConst (TString self#read_string),(Some api#basic_types.tstring)
+					| 13 -> TConst (TBool false),None
+					| 14 -> TConst (TBool true),None
+					| 15 -> TConst (TInt self#read_i32),None
+					| 16 -> TConst (TFloat self#read_string),None
+					| 17 -> TConst (TString self#read_string),None
+
+					(* vars 20-29 *)
+					| 20 ->
+						TLocal (fctx.vars.(read_uleb128 ch)),None
+					| 21 ->
+						let v = declare_local () in
+						TVar (v,None),(Some api#basic_types.tvoid)
+					| 22 ->
+						let v = declare_local () in
+						let e = loop () in
+						TVar (v, Some e),(Some api#basic_types.tvoid)
+
+					(* blocks 30-49 *)
+					| 30 ->
+						TBlock [],None
+					| 31 | 32 | 33 | 34 | 35 as i ->
+						let l = i - 30 in
+						let el = List.init l (fun _ -> loop ()) in
+						TBlock el,None
+					| 36 ->
+						let l = read_byte ch in
+						let el = List.init l (fun _ -> loop ()) in
+						TBlock el,None
+					| 39 ->
+						let el = self#read_list loop in
+						TBlock el,None
+
+					(* function 50-59 *)
+					| 50 ->
+						let read_tfunction_arg () =
+							let v = declare_local () in
+							let cto = self#read_option loop in
+							(v,cto)
+						in
+						let args = self#read_list read_tfunction_arg in
+						let r = self#read_type_instance in
+						let e = loop () in
+						TFunction {
+							tf_args = args;
+							tf_type = r;
+							tf_expr = e;
+						},None
+					(* texpr compounds 60-79 *)
+					| 60 ->
+						let e1 = loop () in
+						let e2 = loop () in
+						TArray (e1,e2),None
+					| 61 ->
+						let e = loop () in
+						TParenthesis e,Some e.etype
+					| 62 ->
+						TArrayDecl (loop_el()),None
+					| 63 ->
+						let fl = self#read_list (fun () ->
+							let name = self#read_string in
+							let p = self#read_pos in
+							let qs = match read_byte ch with
+								| 0 -> NoQuotes
+								| 1 -> DoubleQuotes
+								| _ -> assert false
+							in
+							let e = loop () in
+							((name,p,qs),e)
+						) in
+						TObjectDecl fl,None
+					| 65 ->
+						let m = self#read_metadata_entry in
+						let e1 = loop () in
+						TMeta (m,e1),None
+
+					(* calls 70 - 79 *)
+					| 70 ->
+						let e1 = loop () in
+						TCall(e1,[]),None
+					| 71 | 72 | 73 | 74 as i ->
+						let e1 = loop () in
+						let el = List.init (i - 70) (fun _ -> loop ()) in
+						TCall(e1,el),None
+					| 79 ->
+						let e1 = loop () in
+						let el = self#read_list loop in
+						TCall(e1,el),None
+
+					(* branching 80-89 *)
+					| 80 ->
+						let e1 = loop () in
+						let e2 = loop () in
+						TIf(e1,e2,None),(Some api#basic_types.tvoid)
+					| 81 ->
+						let e1 = loop () in
+						let e2 = loop () in
+						let e3 = loop () in
+						TIf(e1,e2,Some e3),None
+					| 82 ->
+						let subject = loop () in
+						let cases = self#read_list (fun () ->
+							let patterns = loop_el() in
+							let ec = loop () in
+							{ case_patterns = patterns; case_expr = ec}
+						) in
+						let def = self#read_option (fun () -> loop ()) in
+						TSwitch {
+							switch_subject = subject;
+							switch_cases = cases;
+							switch_default = def;
+							switch_exhaustive = true;
+						},None
+					| 83 ->
+						let e1 = loop () in
+						let catches = self#read_list (fun () ->
+							let v = declare_local () in
+							let e = loop () in
+							(v,e)
+						) in
+						TTry(e1,catches),None
+					| 84 ->
+						let e1 = loop () in
+						let e2 = loop () in
+						TWhile(e1,e2,NormalWhile),(Some api#basic_types.tvoid)
+					| 85 ->
+						let e1 = loop () in
+						let e2 = loop () in
+						TWhile(e1,e2,DoWhile),(Some api#basic_types.tvoid)
+					| 86 ->
+						let v  = declare_local () in
+						let e1 = loop () in
+						let e2 = loop () in
+						TFor(v,e1,e2),(Some api#basic_types.tvoid)
+
+					(* control flow 90-99 *)
+					| 90 ->
+						TReturn None,None
+					| 91 ->
+						TReturn (Some (loop ())),None
+					| 92 ->
+						TContinue,None
+					| 93 ->
+						TBreak,None
+					| 94 ->
+						TThrow (loop ()),None
+
+					(* access 100-119 *)
+					| 100 ->
+						TEnumIndex (loop ()),(Some api#basic_types.tint)
+					| 101 ->
+						let e1 = loop () in
+						let ef = self#read_enum_field_ref in
+						let i = read_uleb128 ch in
+						TEnumParameter(e1,ef,i),None
+					| 102 ->
+						let e1 = loop () in
+						let c = self#read_class_ref in
+						let tl = self#read_types in
+						let cf = self#read_field_ref in
+						TField(e1,FInstance(c,tl,cf)),None
+					| 103 ->
+						let e1 = loop () in
+						let c = self#read_class_ref in
+						let cf = self#read_field_ref in
+						TField(e1,FStatic(c,cf)),None
+					| 104 ->
+						let e1 = loop () in
+						let cf = self#read_anon_field_ref in
+						TField(e1,FAnon(cf)),None
+					| 105 ->
+						let e1 = loop () in
+						let c = self#read_class_ref in
+						let tl = self#read_types in
+						let cf = self#read_field_ref in
+						TField(e1,FClosure(Some(c,tl),cf)),None
+					| 106 ->
+						let e1 = loop () in
+						let cf = self#read_anon_field_ref in
+						TField(e1,FClosure(None,cf)),None
+					| 107 ->
+						let e1 = loop () in
+						let en = self#read_enum_ref in
+						let ef = self#read_enum_field_ref in
+						TField(e1,FEnum(en,ef)),None
+					| 108 ->
+						let e1 = loop () in
+						let s = self#read_string in
+						TField(e1,FDynamic s),None
+
+					| 110 ->
+						let p = read_relpos () in
+						let c = self#read_class_ref in
+						let cf = self#read_field_ref in
+						let e1 = Texpr.Builder.make_static_this c p in
+						TField(e1,FStatic(c,cf)),None
+					| 111 ->
+						let p = read_relpos () in
+						let c = self#read_class_ref in
+						let tl = self#read_types in
+						let cf = self#read_field_ref in
+						let ethis = mk (TConst TThis) (Option.get fctx.tthis) p in
+						TField(ethis,FInstance(c,tl,cf)),None
+
+					(* module types 120-139 *)
+					| 120 ->
+						let c = self#read_class_ref in
+						TTypeExpr (TClassDecl c),(Some c.cl_type)
+					| 121 ->
+						let en = self#read_enum_ref in
+						TTypeExpr (TEnumDecl en),(Some en.e_type)
+					| 122 ->
+						TTypeExpr (TAbstractDecl self#read_abstract_ref),None
+					| 123 ->
+						TTypeExpr (TTypeDecl self#read_typedef_ref),None
+					| 124 ->
+						TCast(loop (),None),None
+					| 125 ->
+						let e1 = loop () in
+						let (pack,mname,tname) = self#read_full_path in
+						let mt = self#resolve_type pack mname tname in
+						TCast(e1,Some mt),None
+					| 126 ->
+						let c = self#read_class_ref in
+						let tl = self#read_types in
+						let el = loop_el() in
+						TNew(c,tl,el),None
+					| 127 ->
+						let ttp = self#resolve_ttp_ref (read_uleb128 ch) in
+						let tl = self#read_types in
+						let el = loop_el() in
+						TNew(ttp.ttp_class,tl,el),None
+					| 128 ->
+						let ttp = self#resolve_ttp_ref (read_uleb128 ch) in
+						TTypeExpr (TClassDecl ttp.ttp_class),None
+
+					(* unops 140-159 *)
+					| i when i >= 140 && i < 160 ->
+						let (op,flag) = self#get_unop (i - 140) in
+						let e = loop () in
+						TUnop(op,flag,e),None
+
+					(* binops 160-219 *)
+					| i when i >= 160 && i < 220 ->
+						let op = self#get_binop (i - 160) in
+						let e1 = loop () in
+						let e2 = loop () in
+						TBinop(op,e1,e2),None
+					(* rest 250-254 *)
+					| 250 ->
+						TIdent (self#read_string),None
+
+					| i ->
+						die (Printf.sprintf "  [ERROR] Unhandled texpr %d at:" i) __LOC__
+				in
+				let e,t = loop2 () in
+				let t = match t with
+					| None -> fctx.t_pool.(read_uleb128 ch)
+					| Some t -> t
+				in
+				let p = read_relpos () in
+				let e = {
+					eexpr = e;
+					etype = t;
+					epos = p;
+				} in
+				e
+		and loop_el () =
+			self#read_list loop
+		in
+		loop()
+
+	method read_class_field_forward =
+		let name = self#read_string in
+		let pos,name_pos = self#read_pos_pair in
+		let overloads = self#read_list (fun () -> self#read_class_field_forward) in
+		{ null_field with cf_name = name; cf_pos = pos; cf_name_pos = name_pos; cf_overloads = overloads }
+
+	method start_texpr =
+		begin match read_byte ch with
+			| 0 ->
+				()
+			| 1 ->
+				let a = self#read_type_parameters_forward in
+				local_type_parameters <- a;
+				self#read_type_parameters_data a;
+			| i ->
+				die "" __LOC__
+		end;
+		let tthis = self#read_option (fun () -> self#read_type_instance) in
+		let l = read_uleb128 ch in
+		let ts = Array.init l (fun _ ->
+			self#read_type_instance
+		) in
+		let l = read_uleb128 ch in
+		let vars = Array.init l (fun _ ->
+			self#read_var
+		) in
+		create_field_reader_context self#read_pos ts vars tthis
+
+	method read_field_type_parameters =
+		let num_params = read_uleb128 ch in
+		begin match read_byte ch with
+			| 0 ->
+				()
+			| 1 ->
+				let a = self#read_type_parameters_forward in
+				field_type_parameters <- a;
+				self#read_type_parameters_data a;
+				field_type_parameter_offset <- 0; (* num_params is added below *)
+			| i ->
+				die "" __LOC__
+		end;
+		let params = List.init num_params (fun offset ->
+			field_type_parameters.(field_type_parameter_offset + offset)
+		) in
+		field_type_parameter_offset <- field_type_parameter_offset + num_params;
+		params
+
+	method read_expression (fctx : field_reader_context) =
+		let e = self#read_texpr fctx in
+		let e_unopt = self#read_option (fun () -> self#read_texpr fctx) in
+		e,e_unopt
+
+	val class_field_infos = ClassFieldInfos.create ()
+
+	method read_class_field_data (cf : tclass_field) : unit =
+		let params = self#read_field_type_parameters in
+
+		let t = self#read_type_instance in
+
+		let flags = read_uleb128 ch in
+
+		let doc = self#read_option (fun () -> self#read_documentation) in
+		cf.cf_meta <- self#read_metadata;
+		let kind = self#read_field_kind in
+
+		let expr,expr_unoptimized = match read_byte ch with
+			| 0 ->
+				None,None
+			| 1 ->
+				let fctx = self#start_texpr in
+				let e,e_unopt = self#read_expression fctx in
+				(Some e,e_unopt)
+			| 2 ->
+				(* store type parameter info for EXD *)
+				let info = ClassFieldInfo.create field_type_parameters in
+				ClassFieldInfos.set class_field_infos info cf;
+				None,None
+			| _ ->
+				die "" __LOC__
+		in
+
+		cf.cf_type <- t;
+		cf.cf_doc <- doc;
+		cf.cf_kind <- kind;
+		cf.cf_expr <- expr;
+		cf.cf_expr_unoptimized <- expr_unoptimized;
+		cf.cf_params <- params;
+		cf.cf_flags <- flags
+
+	method read_class_field_and_overloads_data (cf : tclass_field) =
+		let rec loop depth cfl = match cfl with
+			| cf :: cfl ->
+				assert (depth > 0);
+				self#read_class_field_data cf;
+				loop (depth - 1) cfl
+			| [] ->
+				assert (depth = 0)
+		in
+		loop (read_uleb128 ch) (cf :: cf.cf_overloads);
+
+	method select_class_type_parameters (c: tclass) =
+		match c.cl_kind with
+		| KAbstractImpl a ->
+			type_type_parameters <- Array.of_list a.a_params
+		| _ ->
+			type_type_parameters <- Array.of_list c.cl_params
+
+	method read_class_fields (c : tclass) =
+		self#select_class_type_parameters c;
+		let _ = self#read_option (fun f ->
+			let cf = Option.get c.cl_constructor in
+			self#read_class_field_and_overloads_data cf
+		) in
+		let _ = self#read_option (fun f ->
+			let cf = Option.get c.cl_init in
+			self#read_class_field_and_overloads_data cf
+		) in
+		let rec loop ref_kind num cfl = match cfl with
+			| cf :: cfl ->
+				assert (num > 0);
+				self#read_class_field_and_overloads_data cf;
+				loop ref_kind (num - 1) cfl
+			| [] ->
+				assert (num = 0)
+		in
+		loop CfrMember (read_uleb128 ch) c.cl_ordered_fields;
+		loop CfrStatic (read_uleb128 ch) c.cl_ordered_statics;
+		(match c.cl_kind with KModuleFields md -> md.m_statics <- Some c; | _ -> ());
+
+	method read_enum_fields (e : tenum) =
+		type_type_parameters <- Array.of_list e.e_params;
+		ignore(self#read_list (fun () ->
+			let name = self#read_string in
+			let ef = PMap.find name e.e_constrs in
+			ef.ef_params <- self#read_field_type_parameters;
+			ef.ef_type <- self#read_type_instance;
+			ef.ef_doc <- self#read_option (fun () -> self#read_documentation);
+			ef.ef_meta <- self#read_metadata;
+		))
+
+	(* Module types *)
+
+	method read_common_module_type (infos : tinfos) =
+		infos.mt_private <- self#read_bool;
+		infos.mt_doc <- self#read_option (fun () -> self#read_documentation);
+		infos.mt_meta <- self#read_metadata;
+		let params = Array.of_list infos.mt_params in
+		type_type_parameters <- params;
+		self#read_type_parameters_data params;
+		infos.mt_params <- Array.to_list type_type_parameters;
+		infos.mt_using <- self#read_list (fun () ->
+			let c = self#read_class_ref in
+			let p = self#read_pos in
+			(c,p)
+		)
+
+	method read_class_kind = match read_byte ch with
+		| 0 -> KNormal
+		| 1 -> die "" __LOC__
+		| 2 -> KExpr self#read_expr
+		| 3 -> KGeneric
+		| 4 ->
+			let c = self#read_class_ref in
+			let tl = self#read_types in
+			KGenericInstance(c,tl)
+		| 5 -> KMacroType
+		| 6 -> KGenericBuild (self#read_list (fun () -> self#read_cfield))
+		| 7 -> KAbstractImpl self#read_abstract_ref
+		| 8 -> KModuleFields current_module
+		| i ->
+			error (Printf.sprintf "Invalid class kind id: %i" i)
+
+	method read_class (c : tclass) =
+		self#read_common_module_type (Obj.magic c);
+		c.cl_kind <- self#read_class_kind;
+		let read_relation () =
+			let c = self#read_class_ref in
+			let tl = self#read_types in
+			(c,tl)
+		in
+		c.cl_super <- self#read_option read_relation;
+		c.cl_implements <- self#read_list read_relation;
+		c.cl_dynamic <- self#read_option (fun () -> self#read_type_instance);
+		c.cl_array_access <- self#read_option (fun () -> self#read_type_instance);
+
+	method read_abstract (a : tabstract) =
+		self#read_common_module_type (Obj.magic a);
+		a.a_impl <- self#read_option (fun () -> self#read_class_ref);
+		begin match read_byte ch with
+			| 0 ->
+				a.a_this <- TAbstract(a,extract_param_types a.a_params)
+			| _ ->
+				a.a_this <- self#read_type_instance;
+		end;
+		a.a_from <- self#read_list (fun () -> self#read_type_instance);
+		a.a_to <- self#read_list (fun () -> self#read_type_instance);
+		a.a_enum <- self#read_bool;
+
+	method read_abstract_fields (a : tabstract) =
+		a.a_array <- self#read_list (fun () -> self#read_field_ref);
+		a.a_read <- self#read_option (fun () -> self#read_field_ref);
+		a.a_write <- self#read_option (fun () -> self#read_field_ref);
+		a.a_call <- self#read_option (fun () -> self#read_field_ref);
+
+		a.a_ops <- self#read_list (fun () ->
+			let i = read_byte ch in
+			let op = self#get_binop i in
+			let cf = self#read_field_ref in
+			(op, cf)
+		);
+
+		a.a_unops <- self#read_list (fun () ->
+			let i = read_byte ch in
+			let (op, flag) = self#get_unop i in
+			let cf = self#read_field_ref in
+			(op, flag, cf)
+		);
+
+		a.a_from_field <- self#read_list (fun () ->
+			let cf = self#read_field_ref in
+			let t = match cf.cf_type with
+				| TFun((_,_,t) :: _, _) -> t
+				| _ -> die "" __LOC__
+			in
+			(t,cf)
+		);
+
+		a.a_to_field <- self#read_list (fun () ->
+			let cf = self#read_field_ref in
+			let t = match cf.cf_type with
+				| TFun(_, t) -> t
+				| _ -> die "" __LOC__
+			in
+			(t,cf)
+		);
+
+	method read_enum (e : tenum) =
+		self#read_common_module_type (Obj.magic e);
+		e.e_extern <- self#read_bool;
+		e.e_names <- self#read_list (fun () -> self#read_string);
+
+	method read_typedef (td : tdef) =
+		self#read_common_module_type (Obj.magic td);
+		let t = self#read_type_instance in
+		match td.t_type with
+		| TMono r ->
+			(match r.tm_type with
+			| None -> Monomorph.bind r t;
+			| Some t' -> die (Printf.sprintf "typedef %s is already initialized to %s, but new init to %s was attempted" (s_type_path td.t_path) (s_type_kind t') (s_type_kind t)) __LOC__)
+		| _ ->
+			die "" __LOC__
+
+	(* Chunks *)
+
+	method read_string_pool =
+		let l = read_uleb128 ch in
+		Array.init l (fun i ->
+			self#read_raw_string;
+		);
+
+	method read_efr =
+		let l = read_uleb128 ch in
+		let a = Array.init l (fun i ->
+			let en = self#read_enum_ref in
+			let name = self#read_string in
+			PMap.find name en.e_constrs
+		) in
+		enum_fields <- a
+
+	method read_afr =
+		let l = read_uleb128 ch in
+		let a = Array.init l (fun _ -> self#read_class_field_forward) in
+		anon_fields <- a
+
+	method read_cfr =
+		let l = read_uleb128 ch in
+		let a = Array.init l (fun i ->
+			let c = self#read_class_ref in
+			let kind = match read_byte ch with
+				| 0 -> CfrStatic
+				| 1 -> CfrMember
+				| 2 -> CfrConstructor
+				| 3 -> CfrInit
+				| _ -> die "" __LOC__
+			in
+			let cf =  match kind with
+				| CfrStatic ->
+					let name = self#read_string in
+					begin try
+						PMap.find name c.cl_statics
+					with Not_found ->
+						raise (HxbFailure (Printf.sprintf "Could not read static field %s on %s while hxbing %s" name (s_type_path c.cl_path) (s_type_path current_module.m_path)))
+					end;
+				| CfrMember ->
+					let name = self#read_string in
+					begin try
+						PMap.find name c.cl_fields
+					with Not_found ->
+						raise (HxbFailure (Printf.sprintf "Could not read instance field %s on %s while hxbing %s" name (s_type_path c.cl_path) (s_type_path current_module.m_path)))
+					end
+				| CfrConstructor ->
+					Option.get c.cl_constructor
+				| CfrInit ->
+					Option.get c.cl_init
+			in
+			let pick_overload cf depth =
+				let rec loop depth cfl = match cfl with
+					| cf :: cfl ->
+						if depth = 0 then
+							cf
+						else
+							loop (depth - 1) cfl
+					| [] ->
+						raise (HxbFailure (Printf.sprintf "Bad overload depth for %s on %s: %i" cf.cf_name (s_type_path c.cl_path) depth))
+				in
+				let cfl = cf :: cf.cf_overloads in
+				loop depth cfl
+			in
+			let depth = read_uleb128 ch in
+			if depth = 0 then
+				cf
+			else
+				pick_overload cf depth;
+		) in
+		class_fields <- a
+
+	method read_cfd =
+		let l = read_uleb128 ch in
+		for i = 0 to l - 1 do
+			let c = classes.(i) in
+			self#read_class_fields c;
+		done
+
+	method read_exd =
+		ignore(self#read_list (fun () ->
+			let c = self#read_class_ref in
+			self#read_list (fun () ->
+				let cf = self#read_field_ref in
+				let length = read_uleb128 ch in
+				let bytes = read_bytes ch length in
+				let ch_cf = BytesWithPosition.create bytes in
+				let read_expressions () =
+					self#select_class_type_parameters c;
+					field_type_parameters <- (ClassFieldInfos.get class_field_infos cf).type_parameters;
+					ClassFieldInfos.unset class_field_infos cf;
+					field_type_parameter_offset <- 0;
+					let old = ch in
+					ch <- ch_cf;
+					let fctx = self#start_texpr in
+					let e,e_unopt = self#read_expression fctx in
+					ch <- old;
+					cf.cf_expr <- Some e;
+					cf.cf_expr_unoptimized <- e_unopt;
+				in
+				if api#read_expression_eagerly cf then
+					read_expressions ()
+				else begin
+					let t = cf.cf_type in
+					let r = ref (lazy_available t) in
+					r := lazy_wait (fun() ->
+						cf.cf_type <- t;
+						r := lazy_available t;
+						read_expressions ();
+						t
+					);
+					cf.cf_type <- TLazy r
+				end
+			)
+		))
+
+	method read_afd =
+		let l = read_uleb128 ch in
+		for i = 0 to l - 1 do
+			let a = abstracts.(i) in
+			self#read_abstract_fields a;
+		done
+
+	method read_cld =
+		let l = read_uleb128 ch in
+		for i = 0 to l - 1 do
+			let c = classes.(i) in
+			self#read_class c;
+		done
+
+	method read_abd =
+		let l = read_uleb128 ch in
+		for i = 0 to l - 1 do
+			let a = abstracts.(i) in
+			self#read_abstract a;
+		done
+
+	method read_end =
+		let l = read_uleb128 ch in
+		for i = 0 to l - 1 do
+			let en = enums.(i) in
+			self#read_enum en;
+		done
+
+	method read_efd =
+		let l = read_uleb128 ch in
+		for i = 0 to l - 1 do
+			let e = enums.(i) in
+			self#read_enum_fields e;
+			Type.unify (TType(enum_module_type e,[])) e.e_type
+		done
+
+	method read_anon an =
+		let read_fields () =
+			let rec loop acc i =
+				if i = 0 then
+					acc
+				else begin
+					let cf = self#read_anon_field_ref in
+					loop (PMap.add cf.cf_name cf acc) (i - 1)
+				end
+			in
+			an.a_fields <- loop PMap.empty (read_uleb128 ch)
+		in
+
+		begin match read_byte ch with
+		| 0 ->
+			an.a_status := Closed;
+			read_fields ()
+		| 1 ->
+			an.a_status := Const;
+			read_fields ()
+		| 2 ->
+			an.a_status := Extend self#read_types;
+			read_fields ()
+		| _ -> assert false
+		end;
+
+		an
+
+	method read_tdd =
+		let l = read_uleb128 ch in
+		for i = 0 to l - 1 do
+			let t = typedefs.(i) in
+			self#read_typedef t;
+		done
+
+	method read_clr =
+		let l = read_uleb128 ch in
+		classes <- (Array.init l (fun i ->
+				let (pack,mname,tname) = self#read_full_path in
+				match self#resolve_type pack mname tname with
+				| TClassDecl c ->
+					c
+				| _ ->
+					error ("Unexpected type where class was expected: " ^ (s_type_path (pack,tname)))
+		))
+
+	method read_abr =
+		let l = read_uleb128 ch in
+		abstracts <- (Array.init l (fun i ->
+			let (pack,mname,tname) = self#read_full_path in
+			match self#resolve_type pack mname tname with
+			| TAbstractDecl a ->
+				a
+			| _ ->
+				error ("Unexpected type where abstract was expected: " ^ (s_type_path (pack,tname)))
+		))
+
+	method read_enr =
+		let l = read_uleb128 ch in
+		enums <- (Array.init l (fun i ->
+			let (pack,mname,tname) = self#read_full_path in
+			match self#resolve_type pack mname tname with
+			| TEnumDecl en ->
+				en
+			| _ ->
+				error ("Unexpected type where enum was expected: " ^ (s_type_path (pack,tname)))
+		))
+
+	method read_tdr =
+		let l = read_uleb128 ch in
+		typedefs <- (Array.init l (fun i ->
+			let (pack,mname,tname) = self#read_full_path in
+			match self#resolve_type pack mname tname with
+			| TTypeDecl tpd ->
+				tpd
+			| _ ->
+				error ("Unexpected type where typedef was expected: " ^ (s_type_path (pack,tname)))
+		))
+
+	method read_mdr =
+		let length = read_uleb128 ch in
+		for _ = 0 to length - 1 do
+			let path = self#read_path in
+			ignore(api#resolve_module path)
+		done
+
+	method read_mtf =
+		self#read_list (fun () ->
+			let kind = read_byte ch in
+			let path = self#read_path in
+			let pos,name_pos = self#read_pos_pair in
+			let params = self#read_type_parameters_forward in
+			let mt = match kind with
+			| 0 ->
+				let c = mk_class current_module path pos name_pos in
+				c.cl_params <- Array.to_list params;
+				c.cl_flags <- read_uleb128 ch;
+
+				let read_field () =
+					self#read_class_field_forward;
+				in
+
+				c.cl_constructor <- self#read_option read_field;
+				c.cl_init <- self#read_option read_field;
+				let read_fields i =
+					let rec loop acc_l acc_pm i =
+						if i = 0 then
+							acc_l,acc_pm
+						else begin
+							let cf = self#read_class_field_forward in
+							loop (cf :: acc_l) (PMap.add cf.cf_name cf acc_pm) (i - 1)
+						end
+					in
+					loop [] PMap.empty i
+				in
+				let num_fields = read_uleb128 ch in
+				let num_statics = read_uleb128 ch in
+				let l,pm = read_fields num_fields in
+				c.cl_ordered_fields <- l;
+				c.cl_fields <- pm;
+				let l,pm = read_fields num_statics in
+				c.cl_ordered_statics <- l;
+				c.cl_statics <- pm;
+
+				TClassDecl c
+			| 1 ->
+				let en = mk_enum current_module path pos name_pos in
+				en.e_params <- Array.to_list params;
+
+				let read_field () =
+					let name = self#read_string in
+					let pos,name_pos = self#read_pos_pair in
+					let index = read_byte ch in
+
+					{ null_enum_field with
+						ef_name = name;
+						ef_pos = pos;
+						ef_name_pos = name_pos;
+						ef_index = index;
+					}
+				in
+				let rec loop acc i =
+					if i = 0 then
+						acc
+					else begin
+						let ef = read_field () in
+						loop (PMap.add ef.ef_name ef acc) (i - 1)
+					end
+				in
+				en.e_constrs <- loop PMap.empty (read_uleb128 ch);
+				TEnumDecl en
+			| 2 ->
+				let td = mk_typedef current_module path pos name_pos (mk_mono()) in
+				td.t_params <- Array.to_list params;
+				typedefs <- Array.append typedefs (Array.make 1 td);
+				TTypeDecl td
+			| 3 ->
+				let a = mk_abstract current_module path pos name_pos in
+				a.a_params <- Array.to_list params;
+				abstracts <- Array.append abstracts (Array.make 1 a);
+				TAbstractDecl a
+			| _ ->
+				error ("Invalid type kind: " ^ (string_of_int kind));
+			in
+			mt
+		)
+
+	method read_mdf =
+		let path = self#read_path in
+		let file = self#read_string in
+
+		let l = read_uleb128 ch in
+		anons <- Array.init l (fun _ -> { a_fields = PMap.empty; a_status = ref Closed });
+		tmonos <- Array.init (read_uleb128 ch) (fun _ -> mk_mono());
+		api#make_module path file
+
+	method private read_chunk_prefix =
+		let name = Bytes.unsafe_to_string (read_bytes ch 3) in
+		let size = Int32.to_int self#read_i32 in
+		(name,size)
+
+	method private read_chunk_data' (kind : chunk_kind) =
+		match kind with
+		| STR ->
+			string_pool <- self#read_string_pool;
+		| DOC ->
+			doc_pool <- self#read_string_pool;
+		| MDF ->
+			current_module <- self#read_mdf;
+		| MTF ->
+			current_module.m_types <- self#read_mtf;
+			api#add_module current_module;
+		| MDR ->
+			self#read_mdr;
+		| CLR ->
+			self#read_clr;
+		| ENR ->
+			self#read_enr;
+		| ABR ->
+			self#read_abr;
+		| TDR ->
+			self#read_tdr;
+		| AFR ->
+			self#read_afr;
+		| CLD ->
+			self#read_cld;
+		| END ->
+			self#read_end;
+		| ABD ->
+			self#read_abd;
+		| TDD ->
+			self#read_tdd;
+		| EOT ->
+			()
+		| EFR ->
+			self#read_efr;
+		| CFR ->
+			self#read_cfr;
+		| CFD ->
+			self#read_cfd;
+		| EFD ->
+			self#read_efd;
+		| AFD ->
+			self#read_afd;
+		| EOF ->
+			()
+		| EXD ->
+			self#read_exd;
+		| EOM ->
+			incr stats.modules_fully_restored;
+
+	method private read_chunk_data kind =
+		let path = String.concat "_" (ExtLib.String.nsplit (s_type_path mpath) ".") in
+		let id = ["hxb";"read";string_of_chunk_kind kind;path] in
+		let close = Timer.timer id in
+		self#read_chunk_data' kind;
+		close()
+
+	method read_chunks (new_api : hxb_reader_api) (chunks : cached_chunks) =
+		fst (self#read_chunks_until new_api chunks EOM)
+
+	method read_chunks_until (new_api : hxb_reader_api) (chunks : cached_chunks) end_chunk =
+		api <- new_api;
+		let rec loop = function
+			| (kind,data) :: chunks ->
+				ch <- BytesWithPosition.create data;
+				self#read_chunk_data kind;
+				if kind = end_chunk then chunks else loop chunks
+			| [] -> die "" __LOC__
+		in
+		let remaining = loop chunks in
+		(current_module, remaining)
+
+	method read (new_api : hxb_reader_api) (bytes : bytes) =
+		api <- new_api;
+		ch <- BytesWithPosition.create bytes;
+		if (Bytes.to_string (read_bytes ch 3)) <> "hxb" then
+			raise (HxbFailure "magic");
+		let version = read_byte ch in
+		if version <> hxb_version then
+			raise (HxbFailure (Printf.sprintf "version mismatch: hxb version %i, reader version %i" version hxb_version));
+		(fun end_chunk ->
+			let rec loop () =
+				let (name,size) = self#read_chunk_prefix in
+				let kind = chunk_kind_of_string name in
+				self#read_chunk_data kind;
+				if kind <> end_chunk then begin
+					loop()
+				end
+			in
+			loop();
+			current_module
+		)
+end

src/compiler/hxb/hxbReaderApi.ml

@@ -0,0 +1,12 @@
+open Globals
+open Type
+
+class virtual hxb_reader_api = object(self)
+	method virtual make_module : path -> string -> module_def
+	method virtual add_module : module_def -> unit
+	method virtual resolve_type : string list -> string -> string -> module_type
+	method virtual resolve_module : path -> module_def
+	method virtual basic_types : basic_types
+	method virtual get_var_id : int -> int
+	method virtual read_expression_eagerly : tclass_field -> bool
+end