浏览代码

Merge branch 'development' into haxe.runtime.FieldHost

Simon Krajewski 5 月之前
父节点
当前提交
80ce3bd694
共有 100 个文件被更改,包括 2982 次插入2475 次删除
  1. 0 14
      .github/workflows/cancel.yml
  2. 21 20
      .github/workflows/main.yml
  3. 1 2
      extra/github-actions/build-mac.yml
  4. 1 1
      extra/github-actions/install-ocaml-windows.yml
  5. 15 17
      extra/github-actions/workflows/main.yml
  6. 1 0
      haxe.opam
  7. 43 8
      src-json/define.json
  8. 33 12
      src/codegen/dump.ml
  9. 16 13
      src/codegen/genxml.ml
  10. 26 25
      src/codegen/javaModern.ml
  11. 8 6
      src/codegen/swfLoader.ml
  12. 8 5
      src/compiler/args.ml
  13. 17 16
      src/compiler/compilationCache.ml
  14. 3 1
      src/compiler/compilationContext.ml
  15. 56 47
      src/compiler/compiler.ml
  16. 7 8
      src/compiler/displayOutput.ml
  17. 7 19
      src/compiler/displayProcessing.ml
  18. 33 37
      src/compiler/generate.ml
  19. 2 3
      src/compiler/haxe.ml
  20. 0 2
      src/compiler/helper.ml
  21. 21 29
      src/compiler/hxb/hxbLib.ml
  22. 6 13
      src/compiler/hxb/hxbReader.ml
  23. 28 39
      src/compiler/hxb/hxbWriter.ml
  24. 0 2
      src/compiler/hxb/hxbWriterConfig.ml
  25. 14 14
      src/compiler/messageReporting.ml
  26. 24 37
      src/compiler/server.ml
  27. 2 10
      src/compiler/serverCompilationContext.ml
  28. 2 2
      src/compiler/tasks.ml
  29. 18 19
      src/context/abstractCast.ml
  30. 29 138
      src/context/common.ml
  31. 21 14
      src/context/commonCache.ml
  32. 2 2
      src/context/display/display.ml
  33. 5 7
      src/context/display/displayJson.ml
  34. 1 1
      src/context/display/displayTexpr.ml
  35. 211 211
      src/context/display/displayToplevel.ml
  36. 4 4
      src/context/display/exprPreprocessing.ml
  37. 25 29
      src/context/display/findReferences.ml
  38. 4 4
      src/context/display/statistics.ml
  39. 18 18
      src/context/display/syntaxExplorer.ml
  40. 3 3
      src/context/formatString.ml
  41. 0 50
      src/context/lookup.ml
  42. 28 0
      src/context/parallel.ml
  43. 123 0
      src/context/platformConfig.ml
  44. 11 0
      src/context/resolution.ml
  45. 166 0
      src/context/safeCom.ml
  46. 24 15
      src/context/typecore.ml
  47. 9 8
      src/core/abstract.ml
  48. 9 1
      src/core/define.ml
  49. 29 0
      src/core/ds/nowOrLater.ml
  50. 1 10
      src/core/ds/stringPool.ml
  51. 18 0
      src/core/ds/threadSafeHashtbl.ml
  52. 21 0
      src/core/globals.ml
  53. 10 10
      src/core/json/genjson.ml
  54. 3 1
      src/core/path.ml
  55. 10 6
      src/core/tFunctions.ml
  56. 2 2
      src/core/tPrinting.ml
  57. 56 45
      src/core/tUnification.ml
  58. 84 109
      src/core/timer.ml
  59. 6 10
      src/core/warning.ml
  60. 1 0
      src/dune
  61. 0 159
      src/filters/defaultArguments.ml
  62. 47 0
      src/filters/exception/exceptionFunctions.ml
  63. 78 0
      src/filters/exception/exceptionInit.ml
  64. 10 217
      src/filters/exception/exceptions.ml
  65. 126 0
      src/filters/exception/saveStacks.ml
  66. 0 22
      src/filters/exceptionFunctions.ml
  67. 30 9
      src/filters/filterContext.ml
  68. 149 383
      src/filters/filters.ml
  69. 3 60
      src/filters/filtersCommon.ml
  70. 19 19
      src/filters/renameVars.ml
  71. 10 10
      src/filters/safe/addFieldInits.ml
  72. 39 0
      src/filters/safe/addFinalReturn.ml
  73. 26 26
      src/filters/safe/capturedVars.ml
  74. 137 0
      src/filters/safe/checkVarInit.ml
  75. 11 11
      src/filters/safe/localStatic.ml
  76. 82 0
      src/filters/safe/safeFilters.ml
  77. 198 0
      src/filters/safe/sanitize.ml
  78. 14 14
      src/filters/tre.ml
  79. 1 0
      src/generators/cpp/cppAst.ml
  80. 1 0
      src/generators/cpp/cppRetyper.ml
  81. 6 7
      src/generators/cpp/gen/cppGenClassImplementation.ml
  82. 4 2
      src/generators/gctx.ml
  83. 20 20
      src/generators/gencpp.ml
  84. 95 43
      src/generators/genhl.ml
  85. 162 87
      src/generators/genjvm.ml
  86. 18 0
      src/generators/genshared.ml
  87. 18 18
      src/generators/genswf.ml
  88. 1 1
      src/generators/genswf9.ml
  89. 233 171
      src/generators/hl2c.ml
  90. 1 0
      src/generators/hlcode.ml
  91. 8 7
      src/generators/hlopt.ml
  92. 7 0
      src/generators/jvm/jvmClass.ml
  93. 20 14
      src/generators/jvm/jvmFunctions.ml
  94. 11 10
      src/macro/eval/evalContext.ml
  95. 4 3
      src/macro/eval/evalDebug.ml
  96. 14 14
      src/macro/eval/evalDebugMisc.ml
  97. 24 21
      src/macro/eval/evalDebugSocket.ml
  98. 2 2
      src/macro/eval/evalEmitter.ml
  99. 2 2
      src/macro/eval/evalEncode.ml
  100. 4 4
      src/macro/eval/evalJit.ml

+ 0 - 14
.github/workflows/cancel.yml

@@ -1,14 +0,0 @@
-name: Cancel previous jobs
-on:
-  workflow_run:
-    workflows: ["CI"]
-    types:
-      - requested
-jobs:
-  cancel:
-    runs-on: ubuntu-latest
-    steps:
-    - name: Cancel previous runs
-      uses: styfle/[email protected]
-      with:
-        workflow_id: ${{ github.event.workflow.id }}

+ 21 - 20
.github/workflows/main.yml

@@ -4,6 +4,13 @@
 name: CI
 on: [push, pull_request]
 
+env:
+  OCAML_VERSION: 5.3.0
+
+concurrency:
+  group: ${{ github.workflow }}-${{ github.ref }}
+  cancel-in-progress: true
+
 jobs:
   windows64-build:
     runs-on: windows-latest
@@ -48,7 +55,7 @@ jobs:
       - name: Setup ocaml
         uses: ocaml/setup-ocaml@v3
         with:
-          ocaml-compiler: 4
+          ocaml-compiler: ${{ env.OCAML_VERSION }}
           opam-local-packages: |
             haxe.opam
 
@@ -109,10 +116,6 @@ jobs:
     env:
       PLATFORM: linux64
       OPAMYES: 1
-    strategy:
-      fail-fast: false
-      matrix:
-        ocaml: ["4.08.1", "5.0.0"]
     steps:
       - uses: actions/checkout@main
         with:
@@ -123,7 +126,7 @@ jobs:
         uses: actions/cache@v4
         with:
           path: ~/.opam/
-          key: ${{ runner.os }}-${{ matrix.ocaml }}-${{ hashFiles('./haxe.opam', './libs/') }}-1
+          key: ${{ runner.os }}-${{ env.OCAML_VERSION }}-${{ hashFiles('./haxe.opam', './libs/') }}-1
 
       - name: Install Neko from S3
         run: |
@@ -157,9 +160,8 @@ jobs:
         if: steps.cache-opam.outputs.cache-hit != 'true'
         run: |
           set -ex
-          opam init # --disable-sandboxing
+          opam init -c ${{ env.OCAML_VERSION }}
           opam update
-          opam switch create ${{ matrix.ocaml }}
           opam pin add haxe . --no-action
           opam install haxe --deps-only --assume-depexts
           opam list
@@ -187,7 +189,6 @@ jobs:
         run: echo "branch=${GITHUB_REF#refs/heads/}" >> $GITHUB_OUTPUT
 
       - name: Build xmldoc
-        if: matrix.ocaml == '4.08.1'
         run: |
           set -ex
           make -s xmldoc
@@ -201,12 +202,11 @@ jobs:
       - name: Upload artifact
         uses: actions/upload-artifact@v4
         with:
-          name: linuxBinaries${{ (matrix.ocaml == '5.0.0' && '_ocaml5') || '' }}
+          name: linuxBinaries
           path: out
 
       - name: Upload xmldoc artifact
         uses: actions/upload-artifact@v4
-        if: matrix.ocaml == '4.08.1'
         with:
           name: xmldoc
           path: extra/doc
@@ -222,7 +222,6 @@ jobs:
     strategy:
       fail-fast: false
       matrix:
-        ocaml: ["4.08.1", "5.0.0"]
         target: [macro, js, hl, cpp, jvm, php, python, lua, flash, neko]
         include:
           - target: hl
@@ -239,7 +238,7 @@ jobs:
           submodules: recursive
       - uses: actions/download-artifact@v4
         with:
-          name: linuxBinaries${{ (matrix.ocaml == '5.0.0' && '_ocaml5') || '' }}
+          name: linuxBinaries
           path: linuxBinaries
 
       - name: Install Neko from S3
@@ -297,6 +296,7 @@ jobs:
       - name: Test
         run: haxe RunCi.hxml
         working-directory: ${{github.workspace}}/tests
+        timeout-minutes: 20
 
   test-docgen:
     needs: linux-build
@@ -393,7 +393,7 @@ jobs:
         uses: actions/cache@v4
         with:
           path: ~/.opam/
-          key: arm-${{ runner.os }}-${{ hashFiles('./haxe.opam', './libs/') }}
+          key: arm-${{ runner.os }}-${{ env.OCAML_VERSION }}-${{ hashFiles('./haxe.opam', './libs/') }}-1
 
       - name: Install Neko from S3
         run: |
@@ -419,13 +419,13 @@ jobs:
         run: |
           set -ex
           sudo apt-get update -qqy
-          sudo apt-get install -qqy ocaml-nox opam libpcre2-dev zlib1g-dev libgtk2.0-dev libmbedtls-dev ninja-build
+          sudo apt-get install -qqy opam libpcre2-dev zlib1g-dev libgtk2.0-dev libmbedtls-dev ninja-build
 
       - name: Install OCaml libraries
         if: steps.cache-opam.outputs.cache-hit != 'true'
         run: |
           set -ex
-          opam init
+          opam init -c ${{ env.OCAML_VERSION }}
           opam pin add haxe . --no-action
           opam install haxe --deps-only --assume-depexts
           opam list
@@ -533,6 +533,7 @@ jobs:
       - name: Test
         run: haxe RunCi.hxml
         working-directory: ${{github.workspace}}/tests
+        timeout-minutes: 20
 
   mac-build:
     strategy:
@@ -544,7 +545,6 @@ jobs:
       PLATFORM: mac${{ matrix.os == 'macos-14' && '-arm64' || '' }}
       OPAMYES: 1
       MACOSX_DEPLOYMENT_TARGET: 10.13
-      OCAML_VERSION: 5.1.1
     steps:
       - uses: actions/checkout@main
         with:
@@ -555,7 +555,7 @@ jobs:
         uses: actions/cache@v4
         with:
           path: ~/.opam/
-          key: ${{ matrix.os }}-${{ hashFiles('./haxe.opam', './libs/') }}-1
+          key: ${{ matrix.os }}-${{ env.OCAML_VERSION }}-${{ hashFiles('./haxe.opam', './libs/') }}-1
 
       - name: Install Neko from S3
         run: |
@@ -605,9 +605,8 @@ jobs:
         if: steps.cache-opam.outputs.cache-hit != 'true'
         run: |
           set -ex
-          opam init # --disable-sandboxing
+          opam init -c ${{ env.OCAML_VERSION }}
           opam update
-          opam switch create ${{env.OCAML_VERSION}}
           eval $(opam env)
           opam env
           opam pin add haxe . --no-action
@@ -739,6 +738,7 @@ jobs:
         shell: pwsh
         run: haxe RunCi.hxml
         working-directory: ${{github.workspace}}/tests
+        timeout-minutes: 20
 
 
   mac-build-universal:
@@ -849,6 +849,7 @@ jobs:
           echo "" > sys/compile-fs.hxml
           haxe RunCi.hxml
         working-directory: ${{github.workspace}}/tests
+        timeout-minutes: 60
 
 
   deploy:

+ 1 - 2
extra/github-actions/build-mac.yml

@@ -27,9 +27,8 @@
   if: steps.cache-opam.outputs.cache-hit != 'true'
   run: |
     set -ex
-    opam init # --disable-sandboxing
+    opam init -c ${{ env.OCAML_VERSION }}
     opam update
-    opam switch create ${{env.OCAML_VERSION}}
     eval $(opam env)
     opam env
     opam pin add haxe . --no-action

+ 1 - 1
extra/github-actions/install-ocaml-windows.yml

@@ -1,7 +1,7 @@
 - name: Setup ocaml
   uses: ocaml/setup-ocaml@v3
   with:
-    ocaml-compiler: 4
+    ocaml-compiler: ${{ env.OCAML_VERSION }}
     opam-local-packages: |
       haxe.opam
 

+ 15 - 17
extra/github-actions/workflows/main.yml

@@ -3,6 +3,13 @@
 name: CI
 on: [push, pull_request]
 
+env:
+  OCAML_VERSION: 5.3.0
+
+concurrency:
+  group: ${{ github.workflow }}-${{ github.ref }}
+  cancel-in-progress: true
+
 jobs:
   windows64-build:
     runs-on: windows-latest
@@ -28,10 +35,6 @@ jobs:
     env:
       PLATFORM: linux64
       OPAMYES: 1
-    strategy:
-      fail-fast: false
-      matrix:
-        ocaml: ["4.08.1", "5.0.0"]
     steps:
       - uses: actions/checkout@main
         with:
@@ -42,7 +45,7 @@ jobs:
         uses: actions/cache@v4
         with:
           path: ~/.opam/
-          key: ${{ runner.os }}-${{ matrix.ocaml }}-${{ hashFiles('./haxe.opam', './libs/') }}-1
+          key: ${{ runner.os }}-${{ env.OCAML_VERSION }}-${{ hashFiles('./haxe.opam', './libs/') }}-1
 
       @import install-neko-unix.yml
 
@@ -58,9 +61,8 @@ jobs:
         if: steps.cache-opam.outputs.cache-hit != 'true'
         run: |
           set -ex
-          opam init # --disable-sandboxing
+          opam init -c ${{ env.OCAML_VERSION }}
           opam update
-          opam switch create ${{ matrix.ocaml }}
           opam pin add haxe . --no-action
           opam install haxe --deps-only --assume-depexts
           opam list
@@ -88,7 +90,6 @@ jobs:
         run: echo "branch=${GITHUB_REF#refs/heads/}" >> $GITHUB_OUTPUT
 
       - name: Build xmldoc
-        if: matrix.ocaml == '4.08.1'
         run: |
           set -ex
           make -s xmldoc
@@ -102,12 +103,11 @@ jobs:
       - name: Upload artifact
         uses: actions/upload-artifact@v4
         with:
-          name: linuxBinaries${{ (matrix.ocaml == '5.0.0' && '_ocaml5') || '' }}
+          name: linuxBinaries
           path: out
 
       - name: Upload xmldoc artifact
         uses: actions/upload-artifact@v4
-        if: matrix.ocaml == '4.08.1'
         with:
           name: xmldoc
           path: extra/doc
@@ -123,7 +123,6 @@ jobs:
     strategy:
       fail-fast: false
       matrix:
-        ocaml: ["4.08.1", "5.0.0"]
         target: [macro, js, hl, cpp, jvm, php, python, lua, flash, neko]
         include:
           - target: hl
@@ -140,7 +139,7 @@ jobs:
           submodules: recursive
       - uses: actions/download-artifact@v4
         with:
-          name: linuxBinaries${{ (matrix.ocaml == '5.0.0' && '_ocaml5') || '' }}
+          name: linuxBinaries
           path: linuxBinaries
 
       @import install-neko-unix.yml
@@ -258,7 +257,7 @@ jobs:
         uses: actions/cache@v4
         with:
           path: ~/.opam/
-          key: arm-${{ runner.os }}-${{ hashFiles('./haxe.opam', './libs/') }}
+          key: arm-${{ runner.os }}-${{ env.OCAML_VERSION }}-${{ hashFiles('./haxe.opam', './libs/') }}-1
 
       @import install-neko-unix.yml
 
@@ -266,13 +265,13 @@ jobs:
         run: |
           set -ex
           sudo apt-get update -qqy
-          sudo apt-get install -qqy ocaml-nox opam libpcre2-dev zlib1g-dev libgtk2.0-dev libmbedtls-dev ninja-build
+          sudo apt-get install -qqy opam libpcre2-dev zlib1g-dev libgtk2.0-dev libmbedtls-dev ninja-build
 
       - name: Install OCaml libraries
         if: steps.cache-opam.outputs.cache-hit != 'true'
         run: |
           set -ex
-          opam init
+          opam init -c ${{ env.OCAML_VERSION }}
           opam pin add haxe . --no-action
           opam install haxe --deps-only --assume-depexts
           opam list
@@ -373,7 +372,6 @@ jobs:
       PLATFORM: mac${{ matrix.os == 'macos-14' && '-arm64' || '' }}
       OPAMYES: 1
       MACOSX_DEPLOYMENT_TARGET: 10.13
-      OCAML_VERSION: 5.1.1
     steps:
       - uses: actions/checkout@main
         with:
@@ -384,7 +382,7 @@ jobs:
         uses: actions/cache@v4
         with:
           path: ~/.opam/
-          key: ${{ matrix.os }}-${{ hashFiles('./haxe.opam', './libs/') }}-1
+          key: ${{ matrix.os }}-${{ env.OCAML_VERSION }}-${{ hashFiles('./haxe.opam', './libs/') }}-1
 
       @import install-neko-unix.yml
       @import build-mac.yml

+ 1 - 0
haxe.opam

@@ -34,4 +34,5 @@ depends: [
   "luv" {>= "0.5.13"}
   "ipaddr"
   "terminal_size"
+  "domainslib"
 ]

+ 43 - 8
src-json/define.json

@@ -18,7 +18,8 @@
 	},
 	{
 		"name": "AnalyzerTimes",
-		"define": "analyzer-times",
+		"define": "times.analyzer",
+		"deprecatedDefine": "analyzer-times",
 		"doc": "Record detailed timers for the analyzer",
 		"params": ["level: 0 | 1 | 2"]
 	},
@@ -53,6 +54,7 @@
 		"define": "dce",
 		"doc": "Set the dead code elimination mode. (default: std)",
 		"params": ["mode: std | full | no"],
+		"default": "std",
 		"links": ["https://haxe.org/manual/cr-dce.html"]
 	},
 	{
@@ -114,6 +116,7 @@
 		"name": "DumpPath",
 		"define": "dump-path",
 		"doc": "Path to generate dumps to (default: \"dump\").",
+		"default": "dump",
 		"params": ["path"]
 	},
 	{
@@ -124,7 +127,8 @@
 	{
 		"name": "DumpIgnoreVarIds",
 		"define": "dump-ignore-var-ids",
-		"doc": "Remove variable IDs from non-pretty dumps (helps with diff)."
+		"doc": "Remove variable IDs from non-pretty dumps (helps with diff).",
+		"default": "1"
 	},
 	{
 		"name": "DynamicInterfaceClosures",
@@ -137,6 +141,7 @@
 		"define": "eval-call-stack-depth",
 		"doc": "Set maximum call stack depth for eval. (default: 1000)",
 		"platforms": ["eval"],
+		"default": "1000",
 		"params": ["depth"]
 	},
 	{
@@ -150,6 +155,7 @@
 		"define": "eval-print-depth",
 		"doc": "Set maximum print depth (before replacing with '<...>') for eval. (default: 5)",
 		"platforms": ["eval"],
+		"default": "5",
 		"params": ["depth"]
 	},
 	{
@@ -166,7 +172,8 @@
 	},
 	{
 		"name": "EvalTimes",
-		"define": "eval-times",
+		"define": "times.eval",
+		"deprecatedDefine": "eval-times",
 		"doc": "Record per-method execution times in macro/interp mode. Implies eval-stack.",
 		"platforms": ["eval"]
 	},
@@ -177,7 +184,8 @@
 	},
 	{
 		"name": "FilterTimes",
-		"define": "filter-times",
+		"define": "times.filter",
+		"deprecatedDefine": "filter-times",
 		"doc": "Record per-filter execution times upon --times."
 	},
 	{
@@ -238,6 +246,27 @@
 		"doc": "The current Haxe version value in SemVer format.",
 		"reserved": true
 	},
+	{
+		"name": "Haxe3",
+		"define": "haxe3",
+		"doc": "The current Haxe major version is >= 3.",
+		"default": "1",
+		"reserved": true
+	},
+	{
+		"name": "Haxe4",
+		"define": "haxe4",
+		"doc": "The current Haxe major version is >= 4.",
+		"default": "1",
+		"reserved": true
+	},
+	{
+		"name": "Haxe5",
+		"define": "haxe5",
+		"doc": "The current Haxe major version is >= 5.",
+		"default": "1",
+		"reserved": true
+	},
 	{
 		"name": "HaxeNext",
 		"define": "haxe-next",
@@ -267,13 +296,14 @@
 	{
 		"name": "HlVer",
 		"define": "hl-ver",
-		"doc": "The HashLink version to target. (default: 1.10.0)",
+		"doc": "The HashLink version to target. (default: 1.15.0)",
 		"platforms": ["hl"],
 		"params": ["version"]
 	},
 	{
 		"name": "HxbTimes",
-		"define": "hxb-times",
+		"define": "times.hxb",
+		"deprecatedDefine": "hxb-times",
 		"doc": "Display hxb timing when used with `--times`."
 	},
 	{
@@ -480,6 +510,7 @@
 		"name": "LoopUnrollMaxCost",
 		"define": "loop-unroll-max-cost",
 		"doc": "Maximum cost (number of expressions * iterations) before loop unrolling is canceled. (default: 250)",
+		"default": "250",
 		"params": ["cost"]
 	},
 	{
@@ -510,7 +541,8 @@
 	},
 	{
 		"name": "MacroTimes",
-		"define": "macro-times",
+		"define": "times.macro",
+		"deprecatedDefine": "macro-times",
 		"doc": "Display per-macro timing when used with `--times`."
 	},
 	{
@@ -607,7 +639,8 @@
 	{
 		"name": "OldErrorFormat",
 		"define": "old-error-format",
-		"doc": "Use Haxe 3.x zero-based column error messages instead of new one-based format."
+		"doc": "Use Haxe 3.x zero-based column error messages instead of new one-based format.",
+		"deprecated": "OldErrorFormat has been removed in Haxe 5"
 	},
 	{
 		"name": "PhpPrefix",
@@ -804,6 +837,7 @@
 		"name": "MessageReporting",
 		"define": "message.reporting",
 		"doc": "Select message reporting mode for compiler output. (default: pretty)",
+		"default": "pretty",
 		"params": ["mode: classic | pretty | indent"]
 	},
 	{
@@ -825,6 +859,7 @@
 		"name": "MessageLogFormat",
 		"define": "message.log-format",
 		"doc": "Select message reporting mode for message log file. (default: indent)",
+		"default": "indent",
 		"params": ["format: classic | pretty | indent"]
 	}
 ]

+ 33 - 12
src/codegen/dump.ml

@@ -2,6 +2,9 @@ open Globals
 open Common
 open Type
 
+let dump_path defines =
+	Define.defined_value_safe ~default:"dump" defines Define.DumpPath
+
 (*
 	Make a dump of the full typed AST of all types
 *)
@@ -13,13 +16,21 @@ let create_dumpfile acc l =
 		close_out ch)
 
 let create_dumpfile_from_path com path =
-	let buf,close = create_dumpfile [] ((dump_path com) :: (platform_name_macro com) :: fst path @ [snd path]) in
+	let buf,close = create_dumpfile [] ((dump_path com.defines) :: (platform_name_macro com) :: fst path @ [snd path]) in
 	buf,close
 
 let dump_types com pretty =
+	let print_ids = not (Common.defined com Define.DumpIgnoreVarIds) in
+	let restore =
+		if not pretty then
+			let old = !TPrinting.MonomorphPrinting.show_mono_ids in
+			TPrinting.MonomorphPrinting.show_mono_ids := print_ids;
+			fun () -> TPrinting.MonomorphPrinting.show_mono_ids := old
+		else fun () -> ()
+	in
 	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 "")
+		(Type.s_expr_ast print_ids "\t"),(Printer.s_type_param "")
 	else
 		(Type.s_expr_pretty false "\t" true),(s_type_param s_type)
 	in
@@ -27,7 +38,7 @@ let dump_types com pretty =
 		| [] -> ""
 		| l -> Printf.sprintf "<%s>" (String.concat ", " (List.map s_type_param l))
 	in
-	List.iter (fun mt ->
+	let f mt =
 		let path = Type.t_path mt in
 		let buf,close = create_dumpfile_from_path com path in
 		let print fmt = Printf.kprintf (fun s -> Buffer.add_string buf s) fmt in
@@ -117,11 +128,15 @@ let dump_types com pretty =
 			(String.concat " " (List.map (fun t -> " from " ^ s_type t) a.a_from))
 			(String.concat " " (List.map (fun t -> " to " ^ s_type t) a.a_to));
 		);
-		close();
-	) com.types
+		close()
+	in
+	Parallel.run_in_new_pool com.timer_ctx (fun pool ->
+		Parallel.ParallelArray.iter pool f (Array.of_list com.types)
+	);
+	restore()
 
 let dump_record com =
-	List.iter (fun mt ->
+	let f mt =
 		let buf,close = create_dumpfile_from_path com (t_path mt) in
 		let s = match mt with
 			| TClassDecl c -> Printer.s_tclass "" c
@@ -130,11 +145,14 @@ let dump_record com =
 			| TAbstractDecl a -> Printer.s_tabstract "" a
 		in
 		Buffer.add_string buf s;
-		close();
-	) com.types
+		close()
+	in
+	Parallel.run_in_new_pool com.timer_ctx (fun pool ->
+		Parallel.ParallelArray.iter pool f (Array.of_list com.types)
+	)
 
 let dump_position com =
-	List.iter (fun mt ->
+	let f mt =
 		match mt with
 			| TClassDecl c ->
 				let buf,close = create_dumpfile_from_path com (t_path mt) in
@@ -153,7 +171,10 @@ let dump_position com =
 				close();
 			| _ ->
 				()
-	) com.types
+	in
+	Parallel.run_in_new_pool com.timer_ctx (fun pool ->
+		Parallel.ParallelArray.iter pool f (Array.of_list com.types)
+	)
 
 let dump_types com =
 	match Common.defined_value_safe com Define.Dump with
@@ -167,7 +188,7 @@ let dump_dependencies ?(target_override=None) com =
 		| None -> platform_name_macro com
 		| Some s -> s
 	in
-	let dump_dependencies_path = [dump_path com;target_name;"dependencies"] in
+	let dump_dependencies_path = [dump_path com.defines;target_name;"dependencies"] in
 	let buf,close = create_dumpfile [] dump_dependencies_path in
 	let print fmt = Printf.kprintf (fun s -> Buffer.add_string buf s) fmt in
 	let dep = Hashtbl.create 0 in
@@ -190,7 +211,7 @@ let dump_dependencies ?(target_override=None) com =
 		) m.m_extra.m_deps;
 	) com.Common.modules;
 	close();
-	let dump_dependants_path = [dump_path com;target_name;"dependants"] in
+	let dump_dependants_path = [dump_path com.defines;target_name;"dependants"] in
 	let buf,close = create_dumpfile [] dump_dependants_path in
 	let print fmt = Printf.kprintf (fun s -> Buffer.add_string buf s) fmt in
 	Hashtbl.iter (fun n ml ->

+ 16 - 13
src/codegen/genxml.ml

@@ -212,7 +212,7 @@ let rec exists f c =
 			| None -> false
 			| Some (csup,_) -> exists f csup
 
-let rec gen_type_decl com pos t =
+let rec gen_type_decl pos t =
 	let m = (t_infos t).mt_module in
 	match t with
 	| TClassDecl c ->
@@ -257,7 +257,7 @@ let rec gen_type_decl com pos t =
 		let mk_field_cast (t,cf) = if Meta.has Meta.NoDoc cf.cf_meta then None else Some (node "icast" ["field",cf.cf_name] [gen_type t]) in
 		let sub = (match a.a_from,a.a_from_field with [],[] -> [] | l1,l2 -> [node "from" [] ((List.map mk_cast l1) @ (ExtList.List.filter_map mk_field_cast l2))]) in
 		let super = (match a.a_to,a.a_to_field with [],[] -> [] | l1,l2 -> [node "to" [] ((List.map mk_cast l1) @ (ExtList.List.filter_map mk_field_cast l2))]) in
-		let impl = (match a.a_impl with None -> [] | Some c -> [node "impl" [] [gen_type_decl com pos (TClassDecl c)]]) in
+		let impl = (match a.a_impl with None -> [] | Some c -> [node "impl" [] [gen_type_decl pos (TClassDecl c)]]) in
 		let this = [node "this" [] [gen_type a.a_this]] in
 		node "abstract" (gen_type_params pos a.a_private (tpath t) a.a_params a.a_pos m) (sub @ this @ super @ doc @ meta @ impl)
 
@@ -288,18 +288,21 @@ let rec write_xml ch tabs x =
 		IO.printf ch "<![CDATA[%s]]>" s
 
 let generate com file =
-	let t = Timer.timer ["generate";"xml"] in
-	let x = node "haxe" [] (List.map (gen_type_decl com true) (List.filter (fun t -> not (Meta.has Meta.NoDoc (t_infos t).mt_meta)) com.types)) in
-	t();
-	let t = Timer.timer ["write";"xml"] in
-	let ch = IO.output_channel (open_out_bin file) in
-	IO.printf ch "<!-- This file can be parsed by haxe.rtti.XmlParser -->\n";
-	write_xml ch "" x;
-	IO.close_out ch;
-	t()
+	let f () =
+		node "haxe" [] (List.map (gen_type_decl true) (List.filter (fun t -> not (Meta.has Meta.NoDoc (t_infos t).mt_meta)) com.types))
+	in
+	let x = Timer.time com.timer_ctx ["generate";"xml"] f () in
+
+	let f () =
+		let ch = IO.output_channel (open_out_bin file) in
+		IO.printf ch "<!-- This file can be parsed by haxe.rtti.XmlParser -->\n";
+		write_xml ch "" x;
+		IO.close_out ch;
+	in
+	Timer.time com.timer_ctx ["write";"xml"] f ()
 
-let gen_type_string ctx t =
-	let x = gen_type_decl ctx false t in
+let gen_type_string t =
+	let x = gen_type_decl false t in
 	let ch = IO.output_string() in
 	write_xml ch "" x;
 	IO.close_out ch

+ 26 - 25
src/codegen/javaModern.ml

@@ -1018,7 +1018,7 @@ module Converter = struct
 		(pack,types)
 end
 
-class java_library_modern com name file_path = object(self)
+class java_library_modern com  name file_path = object(self)
 	inherit [java_lib_type,unit] native_library name file_path as super
 
 
@@ -1028,35 +1028,36 @@ class java_library_modern com name file_path = object(self)
 	val mutable loaded = false
 	val mutable closed = false
 
+	method private do_load =
+		List.iter (function
+		| ({ Zip.is_directory = false; Zip.filename = filename } as entry) when String.ends_with filename ".class" ->
+			let pack = String.nsplit filename "/" in
+			begin match List.rev pack with
+				| [] -> ()
+				| name :: pack ->
+					let name = String.sub name 0 (String.length name - 6) in
+					let pack = List.rev pack in
+					let pack,(mname,tname) = PathConverter.jpath_to_hx (pack,name) in
+					let path = PathConverter.jpath_to_path (pack,(mname,tname)) in
+					let mname = match mname with
+						| None ->
+							cached_files <- path :: cached_files;
+							tname
+						| Some mname -> mname
+					in
+					Hashtbl.add modules (pack,mname) (filename,entry);
+				end
+		| _ -> ()
+	) (Zip.entries (Lazy.force zip));
+
 	method load =
 		if not loaded then begin
 			loaded <- true;
-			let close = Timer.timer ["jar";"load"] in
-			List.iter (function
-				| ({ Zip.is_directory = false; Zip.filename = filename } as entry) when String.ends_with filename ".class" ->
-					let pack = String.nsplit filename "/" in
-					begin match List.rev pack with
-						| [] -> ()
-						| name :: pack ->
-							let name = String.sub name 0 (String.length name - 6) in
-							let pack = List.rev pack in
-							let pack,(mname,tname) = PathConverter.jpath_to_hx (pack,name) in
-							let path = PathConverter.jpath_to_path (pack,(mname,tname)) in
-							let mname = match mname with
-								| None ->
-									cached_files <- path :: cached_files;
-									tname
-								| Some mname -> mname
-							in
-							Hashtbl.add modules (pack,mname) (filename,entry);
-						end
-				| _ -> ()
-			) (Zip.entries (Lazy.force zip));
-			close();
+			Timer.time com.Common.timer_ctx ["jar";"load"] (fun () -> self#do_load) ()
 		end
 
 	method private read zip (filename,entry) =
-		Std.finally (Timer.timer ["jar";"read"]) (fun () ->
+		Timer.time com.Common.timer_ctx ["jar";"read"] (fun () ->
 			let data = Zip.read_entry zip entry in
 			let jc = JReaderModern.parse_class (IO.input_string data) in
 			(jc,file_path,file_path ^ "@" ^ filename)
@@ -1084,7 +1085,7 @@ class java_library_modern com name file_path = object(self)
 					if entries = [] then raise Not_found;
 					let zip = Lazy.force zip in
 					let jcs = List.map (self#read zip) entries in
-					Std.finally (Timer.timer ["jar";"convert"]) (fun () ->
+					Timer.time com.Common.timer_ctx ["jar";"convert"] (fun () ->
 						Some (Converter.convert_module (fst path) jcs)
 					) ();
 				with Not_found ->

+ 8 - 6
src/codegen/swfLoader.ml

@@ -456,7 +456,6 @@ let build_class com c file =
 	(path.tpackage, [(EClass class_data,pos)])
 
 let extract_data (_,tags) =
-	let t = Timer.timer ["read";"swf"] in
 	let h = Hashtbl.create 0 in
 	let loop_field f =
 		match f.hlf_kind with
@@ -474,9 +473,11 @@ let extract_data (_,tags) =
 			List.iter (fun i -> Array.iter loop_field i.hls_fields) (As3hlparse.parse as3)
 		| _ -> ()
 	) tags;
-	t();
 	h
 
+let extract_data com arg =
+	Timer.time com.timer_ctx ["read";"swf"] extract_data arg
+
 let remove_debug_infos as3 =
 	let hl = As3hlparse.parse as3 in
 	let methods = Hashtbl.create 0 in
@@ -547,8 +548,7 @@ let remove_debug_infos as3 =
 	in
 	As3hlparse.flatten (List.map loop_static hl)
 
-let parse_swf com file =
-	let t = Timer.timer ["read";"swf"] in
+let parse_swf file =
 	let is_swc = Path.file_extension file = "swc" || Path.file_extension file = "ane" in
 	let ch = if is_swc then begin
 		let zip = Zip.open_in file in
@@ -577,9 +577,11 @@ let parse_swf com file =
 			t.tdata <- TActionScript3 (id,remove_debug_infos as3)
 		| _ -> ()
 	) tags;
-	t();
 	(h,tags)
 
+let parse_swf com file =
+	Timer.time com.timer_ctx ["read";"swf"] parse_swf file
+
 class swf_library com name file_path = object(self)
 	inherit [swf_lib_type,Swf.swf] native_library name file_path
 
@@ -600,7 +602,7 @@ class swf_library com name file_path = object(self)
 
 	method extract = match swf_classes with
 		| None ->
-			let d = extract_data self#get_swf in
+			let d = extract_data com self#get_swf in
 			swf_classes <- Some d;
 			d
 		| Some d ->

+ 8 - 5
src/compiler/args.ml

@@ -64,6 +64,7 @@ let parse_args com =
 		raise_usage = (fun () -> ());
 		display_arg = None;
 		deprecations = [];
+		measure_times = false;
 	} in
 	let add_deprecation s =
 		actx.deprecations <- s :: actx.deprecations
@@ -104,9 +105,9 @@ 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.main_class with
+			(match com.main.main_path with
 				| Some c -> if cpath <> c then raise (Arg.Bad "Multiple --main classes specified")
-				| None -> com.main.main_class <- Some cpath);
+				| None -> com.main.main_path <- Some cpath);
 			actx.classes <- cpath :: actx.classes;
 			Common.define com Define.Interp;
 			set_platform com Eval "";
@@ -131,9 +132,9 @@ let parse_args com =
 			actx.hxb_libs <- lib :: actx.hxb_libs
 		),"<path>","add a hxb library");
 		("Compilation",["-m";"--main"],["-main"],Arg.String (fun cl ->
-			if com.main.main_class <> None then raise (Arg.Bad "Multiple --main classes specified");
+			if com.main.main_path <> None then raise (Arg.Bad "Multiple --main classes specified");
 			let cpath = Path.parse_type_path cl in
-			com.main.main_class <- Some cpath;
+			com.main.main_path <- Some cpath;
 			actx.classes <- cpath :: actx.classes
 		),"<class>","select startup class");
 		("Compilation",["-L";"--library"],["-lib"],Arg.String (fun _ -> ()),"<name[:ver]>","use a haxelib library");
@@ -261,7 +262,9 @@ let parse_args com =
 			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");
+		("Debug",["--times"],[], Arg.Unit (fun() ->
+			actx.measure_times <- true
+		),"","measure compilation times");
 		("Optimization",["--no-inline"],[],Arg.Unit (fun () ->
 			add_deprecation "--no-inline has been deprecated, use -D no-inline instead";
 			Common.define com Define.NoInline

+ 17 - 16
src/compiler/compilationCache.ml

@@ -36,7 +36,6 @@ class context_cache (index : int) (sign : Digest.t) = object(self)
 	val modules : (path,module_def) Hashtbl.t = Hashtbl.create 0
 	val binary_cache : (path,HxbData.module_cache) Hashtbl.t = Hashtbl.create 0
 	val tmp_binary_cache : (path,HxbData.module_cache) Hashtbl.t = Hashtbl.create 0
-	val string_pool  = StringPool.create ()
 	val removed_files = Hashtbl.create 0
 	val mutable json = JNull
 	val mutable initialized = false
@@ -81,20 +80,25 @@ class context_cache (index : int) (sign : Digest.t) = object(self)
 		try (Hashtbl.find modules path).m_extra
 		with Not_found -> (self#get_hxb_module path).mc_extra
 
-	method cache_hxb_module config warn anon_identification path m =
+	method add_binary_cache m chunks =
+		Hashtbl.replace binary_cache m.m_path {
+			mc_path = m.m_path;
+			mc_id = m.m_id;
+			mc_chunks = chunks;
+			mc_extra = { m.m_extra with m_cache_state = MSGood; m_display_deps = None }
+		}
+
+	method cache_hxb_module config warn anon_identification m =
 		match m.m_extra.m_kind with
 		| MImport ->
-			Hashtbl.add modules m.m_path m
+			Hashtbl.add modules m.m_path m;
+			None
 		| _ ->
-			let writer = HxbWriter.create config (Some string_pool) 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; m_display_deps = None }
-			}
+			Some (fun () ->
+				let writer = HxbWriter.create config warn anon_identification in
+				HxbWriter.write_module writer m;
+				HxbWriter.get_chunks writer
+			)
 
 	method cache_module_in_memory path m =
 		Hashtbl.replace modules path m
@@ -117,8 +121,6 @@ class context_cache (index : int) (sign : Digest.t) = object(self)
 	method get_modules = modules
 
 	method get_hxb = binary_cache
-	method get_string_pool = string_pool
-	method get_string_pool_arr = string_pool.items.arr
 
 	(* TODO handle hxb cache there too *)
 	method get_removed_files = removed_files
@@ -140,8 +142,7 @@ class virtual server_task (id : string list) (priority : int) = object(self)
 	method private virtual execute : unit
 
 	method run : unit =
-		let t = Timer.timer ("server" :: "task" :: id) in
-		Std.finally t (fun () -> self#execute) ()
+		self#execute
 
 	method get_priority = priority
 	method get_id = id

+ 3 - 1
src/compiler/compilationContext.ml

@@ -37,13 +37,14 @@ type arg_context = {
 	mutable raise_usage : unit -> unit;
 	mutable display_arg : string option;
 	mutable deprecations : string list;
+	mutable measure_times : bool;
 }
 
 type communication = {
 	write_out : string -> unit;
 	write_err : string -> unit;
 	flush     : compilation_context -> unit;
-	exit      : int -> unit;
+	exit      : Timer.timer_context -> int -> unit;
 	is_server : bool;
 }
 
@@ -54,6 +55,7 @@ and compilation_context = {
 	mutable has_error : bool;
 	comm : communication;
 	mutable runtime_args : string list;
+	timer_ctx : Timer.timer_context;
 }
 
 type compilation_callbacks = {

+ 56 - 47
src/compiler/compiler.ml

@@ -33,7 +33,6 @@ let run_or_diagnose ctx f =
 		f ()
 
 let run_command ctx cmd =
-	let t = Timer.timer ["command";cmd] in
 	(* TODO: this is a hack *)
 	let cmd = if ctx.comm.is_server then begin
 		let h = Hashtbl.create 0 in
@@ -72,9 +71,11 @@ let run_command ctx cmd =
 			result
 		end
 	in
-	t();
 	result
 
+let run_command ctx cmd =
+	Timer.time ctx.timer_ctx ["command";cmd] (run_command ctx) cmd
+
 module Setup = struct
 	let initialize_target ctx com actx =
 		init_platform com;
@@ -231,12 +232,9 @@ module Setup = struct
 		let com = ctx.com in
 		ctx.com.print <- ctx.comm.write_out;
 		Common.define_value com Define.HaxeVer (Printf.sprintf "%.3f" (float_of_int version /. 1000.));
-		Common.raw_define com "haxe3";
-		Common.raw_define com "haxe4";
-		Common.raw_define com "haxe5";
 		Common.define_value com Define.Haxe s_version;
 		Common.raw_define com "true";
-		Common.define_value com Define.Dce "std";
+		List.iter (fun (k,v) -> Define.raw_define_value com.defines k v) DefineList.default_values;
 		com.info <- (fun ?(depth=0) ?(from_macro=false) msg p ->
 			message ctx (make_compiler_message ~from_macro msg p depth DKCompilerMessage Information)
 		);
@@ -273,11 +271,17 @@ end
 
 let check_defines com =
 	if is_next com then begin
-		PMap.iter (fun k _ ->
+		PMap.iter (fun k v ->
 			try
 				let reason = Hashtbl.find Define.deprecation_lut k in
 				let p = fake_pos ("-D " ^ k) in
-				com.warning WDeprecatedDefine [] reason p
+				begin match reason with
+				| DueTo reason ->
+					com.warning WDeprecatedDefine [] reason p
+				| InFavorOf d ->
+					Define.raw_define_value com.defines d v;
+					com.warning WDeprecatedDefine [] (Printf.sprintf "-D %s has been deprecated in favor of -D %s" k d) p
+				end;
 			with Not_found ->
 				()
 		) com.defines.values
@@ -286,7 +290,6 @@ let check_defines com =
 (** Creates the typer context and types [classes] into it. *)
 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;
@@ -327,26 +330,27 @@ let do_type ctx mctx actx display_file_dot_path =
 		| (DMUsage _ | DMImplementation) -> FindReferences.find_possible_references tctx cs;
 		| _ -> ()
 	end;
-	t();
 	(tctx, display_file_dot_path)
 
 let finalize_typing ctx tctx =
-	let t = Timer.timer ["finalize"] in
 	let com = ctx.com in
 	let main_module = Finalization.maybe_load_main tctx in
 	enter_stage com CFilteringStart;
 	ServerMessage.compiler_stage com;
-	let main, types, modules = run_or_diagnose ctx (fun () -> Finalization.generate tctx main_module) in
-	com.main.main_expr <- main;
+	let (main_expr,main_file),types,modules = run_or_diagnose ctx (fun () -> Finalization.generate tctx main_module) in
+	com.main.main_expr <- main_expr;
+	com.main.main_file <- main_file;
 	com.types <- types;
-	com.modules <- modules;
-	t()
+	com.modules <- modules
+
+let finalize_typing ctx tctx =
+	Timer.time ctx.timer_ctx ["finalize"] (finalize_typing ctx) tctx
 
 let filter ctx tctx ectx before_destruction =
-	let t = Timer.timer ["filters"] in
-	DeprecationCheck.run ctx.com;
-	run_or_diagnose ctx (fun () -> Filters.run tctx ectx ctx.com.main.main_expr before_destruction);
-	t()
+	Timer.time ctx.timer_ctx ["filters"] (fun () ->
+		DeprecationCheck.run ctx.com;
+		run_or_diagnose ctx (fun () -> Filters.run tctx ectx ctx.com.main.main_expr before_destruction)
+	) ()
 
 let compile ctx actx callbacks =
 	let com = ctx.com in
@@ -370,24 +374,24 @@ let compile ctx actx callbacks =
 	let ext = Setup.initialize_target ctx com actx in
 	update_platform_config com; (* make sure to adapt all flags changes defined after platform *)
 	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();
+	Timer.time ctx.timer_ctx ["init"] (fun () ->
+		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;
+	) ();
 	enter_stage com CInitialized;
 	ServerMessage.compiler_stage com;
 	if actx.classes = [([],"Std")] && not actx.force_typing then begin
 		if actx.cmds = [] && not actx.did_something then actx.raise_usage();
 	end else begin
 		(* Actual compilation starts here *)
-		let (tctx,display_file_dot_path) = do_type ctx mctx actx display_file_dot_path in
+		let (tctx,display_file_dot_path) = Timer.time ctx.timer_ctx ["typing"] (do_type ctx mctx actx) display_file_dot_path in
 		DisplayProcessing.handle_display_after_typing ctx tctx display_file_dot_path;
-		let ectx = Exceptions.create_exception_context tctx in
+		let ectx = ExceptionInit.create_exception_context tctx in
 		finalize_typing ctx tctx;
 		let is_compilation = is_compilation com in
 		com.callbacks#add_after_save (fun () ->
@@ -399,10 +403,10 @@ let compile ctx actx callbacks =
 					()
 		);
 		if is_diagnostics com then
-			filter ctx tctx ectx (fun () -> DisplayProcessing.handle_display_after_finalization ctx tctx display_file_dot_path)
+			filter ctx com ectx (fun () -> DisplayProcessing.handle_display_after_finalization ctx tctx display_file_dot_path)
 		else begin
 			DisplayProcessing.handle_display_after_finalization ctx tctx display_file_dot_path;
-			filter ctx tctx ectx (fun () -> ());
+			filter ctx com ectx (fun () -> ());
 		end;
 		if ctx.has_error then raise Abort;
 		if is_compilation then Generate.check_auxiliary_output com actx;
@@ -422,7 +426,7 @@ let compile ctx actx callbacks =
 		) (List.rev actx.cmds)
 	end
 
-let make_ice_message com msg backtrace = 
+let make_ice_message com msg backtrace =
 		let ver = (s_version_full com.version) in
 		let os_type = if Sys.unix then "unix" else "windows" in
 		Printf.sprintf "%s\nHaxe: %s; OS type: %s;\n%s" msg ver os_type backtrace
@@ -438,7 +442,7 @@ with
 	| Parser.Error (m,p) ->
 		error ctx (Parser.error_msg m) p
 	| Typecore.Forbid_package ((pack,m,p),pl,pf)  ->
-		if !Parser.display_mode <> DMNone && ctx.has_next then begin
+		if ctx.com.display.dms_kind <> DMNone && ctx.has_next then begin
 			ctx.has_error <- false;
 			ctx.messages <- [];
 		end else begin
@@ -455,7 +459,7 @@ with
 		error ctx ("Error: " ^ msg) null_pos
 	| Globals.Ice (msg,backtrace) when is_diagnostics com ->
 		let s = make_ice_message com msg backtrace in
-		handle_diagnostics ctx s null_pos DKCompilerMessage 
+		handle_diagnostics ctx s null_pos DKCompilerMessage
 	| Globals.Ice (msg,backtrace) when not Helper.is_debug_run ->
 		let s = make_ice_message com msg backtrace in
 		error ctx ("Error: " ^ s) null_pos
@@ -503,6 +507,8 @@ let catch_completion_and_exit ctx callbacks run =
 			i
 
 let process_actx ctx actx =
+	ctx.com.doinline <- ctx.com.display.dms_inline && not (Common.defined ctx.com Define.NoInline);
+	ctx.timer_ctx.measure_times <- (if actx.measure_times then Yes else No);
 	DisplayProcessing.process_display_arg ctx actx;
 	List.iter (fun s ->
 		ctx.com.warning WDeprecated [] s null_pos
@@ -529,30 +535,30 @@ let compile_ctx callbacks ctx =
 	end else
 		catch_completion_and_exit ctx callbacks run
 
-let create_context comm cs compilation_step params = {
-	com = Common.create compilation_step cs {
+let create_context comm cs timer_ctx compilation_step params = {
+	com = Common.create timer_ctx compilation_step cs {
 		version = version;
 		major = version_major;
 		minor = version_minor;
 		revision = version_revision;
 		pre = version_pre;
 		extra = Version.version_extra;
-	} params (DisplayTypes.DisplayMode.create !Parser.display_mode);
+	} params (DisplayTypes.DisplayMode.create DMNone);
 	messages = [];
 	has_next = false;
 	has_error = false;
 	comm = comm;
 	runtime_args = [];
+	timer_ctx = timer_ctx;
 }
 
 module HighLevel = struct
-	let add_libs libs args cs has_display =
+	let add_libs timer_ctx libs args cs has_display =
 		let global_repo = List.exists (fun a -> a = "--haxelib-global") args in
 		let fail msg =
 			raise (Arg.Bad msg)
 		in
 		let call_haxelib() =
-			let t = Timer.timer ["haxelib"] in
 			let cmd = "haxelib" ^ (if global_repo then " --global" else "") ^ " path " ^ String.concat " " libs in
 			let pin, pout, perr = Unix.open_process_full cmd (Unix.environment()) in
 			let lines = Std.input_list pin in
@@ -562,9 +568,11 @@ module HighLevel = struct
 				| [], [] -> "Failed to call haxelib (command not found ?)"
 				| [], [s] when ExtString.String.ends_with (ExtString.String.strip s) "Module not found: path" -> "The haxelib command has been strip'ed, please install it again"
 				| _ -> String.concat "\n" (lines@err));
-			t();
 			lines
 		in
+		let call_haxelib () =
+			Timer.time timer_ctx ["haxelib"] call_haxelib ()
+		in
 		match libs with
 		| [] ->
 			[]
@@ -598,7 +606,7 @@ module HighLevel = struct
 			lines
 
 	(* Returns a list of contexts, but doesn't do anything yet *)
-	let process_params server_api create each_args has_display is_server args =
+	let process_params server_api timer_ctx create each_args has_display is_server args =
 		(* We want the loop below to actually see all the --each params, so let's prepend them *)
 		let args = !each_args @ args in
 		let added_libs = Hashtbl.create 0 in
@@ -656,14 +664,14 @@ module HighLevel = struct
 				let libs,args = find_subsequent_libs [name] args in
 				let libs = List.filter (fun l -> not (Hashtbl.mem added_libs l)) libs in
 				List.iter (fun l -> Hashtbl.add added_libs l ()) libs;
-				let lines = add_libs libs args server_api.cache has_display in
+				let lines = add_libs timer_ctx libs args server_api.cache has_display in
 				loop acc (lines @ args)
 			| ("--jvm" | "-jvm" as arg) :: dir :: args ->
 				loop_lib arg dir "hxjava" acc args
 			| arg :: l ->
 				match List.rev (ExtString.String.nsplit arg ".") with
 				| "hxml" :: _ :: _ when (match acc with "-cmd" :: _ | "--cmd" :: _ -> false | _ -> true) ->
-					let full_path = Extc.get_full_path arg in
+					let full_path = try Extc.get_full_path arg with Failure(_) -> raise (Arg.Bad (Printf.sprintf "File not found: %s" arg)) in
 					if List.mem full_path !hxml_stack then
 						raise (Arg.Bad (Printf.sprintf "Duplicate hxml inclusion: %s" full_path))
 					else
@@ -701,7 +709,8 @@ module HighLevel = struct
 		end
 
 	let entry server_api comm args =
-		let create = create_context comm server_api.cache in
+		let timer_ctx = Timer.make_context (Timer.make ["other"]) in
+		let create = create_context comm server_api.cache timer_ctx in
 		let each_args = ref [] in
 		let curdir = Unix.getcwd () in
 		let has_display = ref false in
@@ -715,7 +724,7 @@ module HighLevel = struct
 		in
 		let rec loop args =
 			let args,server_mode,ctx = try
-				process_params server_api create each_args !has_display comm.is_server args
+				process_params server_api timer_ctx create each_args !has_display comm.is_server args
 			with Arg.Bad msg ->
 				let ctx = create 0 args in
 				error ctx ("Error: " ^ msg) null_pos;
@@ -738,5 +747,5 @@ module HighLevel = struct
 				code
 		in
 		let code = loop args in
-		comm.exit code
+		comm.exit timer_ctx code
 end

+ 7 - 8
src/compiler/displayOutput.ml

@@ -1,7 +1,6 @@
 open Globals
 open Ast
 open Common
-open Timer
 open DisplayTypes.DisplayMode
 open DisplayTypes.CompletionResultKind
 open CompletionItem
@@ -24,14 +23,15 @@ let htmlescape s =
 	let s = String.concat "&quot;" (ExtString.String.nsplit s "\"") in
 	s
 
-let get_timer_fields start_time =
+let get_timer_fields timer_ctx =
+	let open Timer in
 	let tot = ref 0. in
-	Hashtbl.iter (fun _ t -> tot := !tot +. t.total) Timer.htimers;
-	let fields = [("@TOTAL", Printf.sprintf "%.3fs" (get_time() -. start_time))] in
+	Hashtbl.iter (fun _ t -> tot := !tot +. t.total) timer_ctx.timer_lut;
+	let fields = [("@TOTAL", Printf.sprintf "%.3fs" (Extc.time() -. timer_ctx.start_time))] in
 	if !tot > 0. then
 		Hashtbl.fold (fun _ t acc ->
 			((String.concat "." t.id),(Printf.sprintf "%.3fs (%.0f%%)" t.total (t.total *. 100. /. !tot))) :: acc
-		) Timer.htimers fields
+		) timer_ctx.timer_lut fields
 	else
 		fields
 
@@ -272,11 +272,10 @@ let handle_display_exception_old ctx dex = match dex with
 		raise (Completion (String.concat "." pack))
 	| DisplayFields r ->
 		DisplayPosition.display_position#reset;
-		let fields = if !Timer.measure_times then begin
-			Timer.close_times();
+		let fields = if ctx.com.timer_ctx.measure_times = Yes then begin
 			(List.map (fun (name,value) ->
 				CompletionItem.make_ci_timer ("@TIME " ^ name) value
-			) (get_timer_fields !Helper.start_time)) @ r.fitems
+			) (get_timer_fields ctx.com.timer_ctx)) @ r.fitems
 		end else
 			r.fitems
 		in

+ 7 - 19
src/compiler/displayProcessing.ml

@@ -29,7 +29,6 @@ let handle_display_argument_old com file_pos actx =
 		let file_unique = com.file_keys#get file in
 		let pos, smode = try ExtString.String.split pos "@" with _ -> pos,"" in
 		let create mode =
-			Parser.display_mode := mode;
 			DisplayTypes.DisplayMode.create mode
 		in
 		let dm = match smode with
@@ -81,7 +80,7 @@ let process_display_arg ctx actx =
 		if String.length input > 0 && (input.[0] = '[' || input.[0] = '{') then begin
 			actx.did_something <- true;
 			actx.force_typing <- true;
-			DisplayJson.parse_input ctx.com input Timer.measure_times
+			DisplayJson.parse_input ctx.com input
 		end else
 			handle_display_argument_old ctx.com input actx;
 	| None ->
@@ -103,17 +102,6 @@ let process_display_configuration ctx =
 			| WMDisable ->
 				()
 		);
-	end;
-	Lexer.old_format := Common.defined com Define.OldErrorFormat;
-	if !Lexer.old_format && !Parser.in_display then begin
-		let p = DisplayPosition.display_position#get in
-		(* convert byte position to utf8 position *)
-		try
-			let content = Std.input_file ~bin:true (Path.get_real_path p.pfile) in
-			let pos = Extlib_leftovers.UTF8.length (String.sub content 0 p.pmin) in
-			DisplayPosition.display_position#set { p with pmin = pos; pmax = pos }
-		with _ ->
-			() (* ignore *)
 	end
 
 let process_display_file com actx =
@@ -143,7 +131,7 @@ let process_display_file com actx =
 			DPKNone
 		| DFPOnly when (DisplayPosition.display_position#get).pfile = file_input_marker ->
 			actx.classes <- [];
-			com.main.main_class <- None;
+			com.main.main_path <- None;
 			begin match com.file_contents with
 			| [_, Some input] ->
 				com.file_contents <- [];
@@ -154,7 +142,7 @@ let process_display_file com actx =
 		| dfp ->
 			if dfp = DFPOnly then begin
 				actx.classes <- [];
-				com.main.main_class <- None;
+				com.main.main_path <- None;
 			end;
 			let dpk = List.map (fun file_key ->
 				let real = Path.get_real_path (Path.UniqueKey.to_string file_key) in
@@ -276,7 +264,7 @@ let maybe_load_display_file_before_typing tctx display_file_dot_path = match dis
 let handle_display_after_typing ctx tctx display_file_dot_path =
 	let com = ctx.com in
 	if ctx.com.display.dms_kind = DMNone && ctx.has_error then raise Abort;
-	begin match ctx.com.display.dms_kind,!Parser.delayed_syntax_completion with
+	begin match ctx.com.display.dms_kind,Atomic.get ctx.com.parser_state.delayed_syntax_completion with
 		| DMDefault,Some(kind,subj) -> DisplayOutput.handle_syntax_completion com kind subj
 		| _ -> ()
 	end;
@@ -315,9 +303,9 @@ let process_global_display_mode com tctx =
 	promote_type_hints tctx;
 	match com.display.dms_kind with
 	| DMUsage (with_definition,_,_) ->
-		FindReferences.find_references tctx com with_definition
+		FindReferences.find_references com with_definition
 	| DMImplementation ->
-		FindReferences.find_implementations tctx com
+		FindReferences.find_implementations com
 	| DMModuleSymbols filter ->
 		let open CompilationCache in
 		let cs = com.cs in
@@ -359,7 +347,7 @@ let handle_display_after_finalization ctx tctx display_file_dot_path =
 	| RMDiagnostics _ ->
 		DisplayOutput.emit_diagnostics com
 	| RMStatistics ->
-		DisplayOutput.emit_statistics tctx
+		DisplayOutput.emit_statistics com
 	| RMNone ->
 		()
 	end

+ 33 - 37
src/compiler/generate.ml

@@ -18,20 +18,20 @@ let check_auxiliary_output com actx =
 		| Some file ->
 			Common.log com ("Generating json : " ^ file);
 			Path.mkdir_from_path file;
-			Genjson.generate com.types file
+			Genjson.generate com.timer_ctx com.types file
 	end
 
-let create_writer com config string_pool =
+let create_writer com config =
 	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 string_pool warn anon_identification in
+	let writer = HxbWriter.create config warn anon_identification in
 	writer,(fun () ->
 		let out = IO.output_string () in
 		HxbWriter.export writer out;
 		IO.close_out out
 	)
 
-let export_hxb from_cache com config string_pool cc platform zip m =
+let export_hxb from_cache com config cc platform m =
 	let open HxbData in
 	match m.m_extra.m_kind with
 		| MCode | MMacro | MFake | MExtern -> begin
@@ -48,69 +48,65 @@ let export_hxb from_cache com config string_pool cc platform zip m =
 					IO.nwrite out data
 				) hxb_cache.mc_chunks;
 				let data = IO.close_out out in
-				zip#add_entry data path;
+				Some (path,data)
 			end else begin
-				let writer,close = create_writer com config string_pool in
+				let writer,close = create_writer com config in
 				HxbWriter.write_module writer m;
 				let bytes = close () in
-				zip#add_entry bytes path;
+				Some (path,bytes)
 			end
 		end
 	| _ ->
-		()
+		None
 
 let check_hxb_output ctx config =
 	let open HxbWriterConfig in
 	let com = ctx.com in
-	let write_string_pool config zip name pool =
-		let writer,close = create_writer com config (Some pool) in
-		let a = StringPool.finalize writer.cp in
-		HxbWriter.HxbWriter.write_string_pool writer STR a;
-		let bytes = close () in
-		zip#add_entry bytes name;
-	in
 	let match_path_list l sl_path =
 		List.exists (fun sl -> Ast.match_path true sl_path sl) l
 	in
 	let try_write from_cache =
 		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
+		let t = Timer.start_timer ctx.timer_ctx ["generate";"hxb"] in
 		Path.mkdir_from_path path;
 		let zip = new Zip_output.zip_output path 6 in
-		let export com config string_pool =
+		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 f m =
 				let sl_path = fst m.m_path @ [snd m.m_path] in
 				if not (match_path_list config.exclude sl_path) || match_path_list config.include' sl_path then
-					Std.finally t (export_hxb from_cache com config string_pool cc target zip) m
-			) com.modules;
+					Timer.time ctx.timer_ctx ["generate";"hxb";s_type_path m.m_path] (export_hxb from_cache com config cc target) m
+				else
+					None
+			in
+			let a_in = Array.of_list com.modules in
+			let a_out = Parallel.run_in_new_pool com.timer_ctx (fun pool ->
+				Parallel.ParallelArray.map pool f a_in None
+			) in
+			Array.iter (function
+				| None ->
+					()
+				| Some(path,bytes) ->
+					zip#add_entry bytes path
+			) a_out
 		in
 		Std.finally (fun () ->
 			zip#close;
 			t()
 		) (fun () ->
-			let string_pool = if config.share_string_pool then Some (StringPool.create ()) else None in
 			if config.target_config.generate then begin
-				export com config.target_config string_pool;
+				export com config.target_config
 			end;
 
 			if config.macro_config.generate then begin
 				match com.get_macros() with
 					| Some mcom ->
-						let use_separate_pool = config.share_string_pool && from_cache in
-						let string_pool = if use_separate_pool then Some (StringPool.create ()) else string_pool in
-						export mcom config.macro_config string_pool;
-						if use_separate_pool then write_string_pool config.macro_config zip "StringPool.macro.hxb" (Option.get string_pool)
+						export mcom config.macro_config;
 					| _ ->
 						()
 			end;
-
-			if config.share_string_pool then
-				write_string_pool config.target_config zip "StringPool.hxb" (Option.get string_pool);
 		) ()
 	in
 	try
@@ -135,8 +131,10 @@ let delete_file f = try Sys.remove f with _ -> ()
 let maybe_generate_dump ctx tctx =
 	let com = tctx.Typecore.com in
 	if Common.defined com Define.Dump then begin
-		Dump.dump_types com;
-		Option.may Dump.dump_types (com.get_macros())
+		Timer.time ctx.timer_ctx ["generate";"dump"] (fun () ->
+			Dump.dump_types com;
+			Option.may Dump.dump_types (com.get_macros());
+		) ();
 	end;
 	if Common.defined com Define.DumpDependencies then begin
 		Dump.dump_dependencies com;
@@ -158,7 +156,7 @@ let generate ctx tctx ext actx =
 		| _ -> Path.mkdir_from_path com.file
 	end;
 	if actx.interp then begin
-		let timer = Timer.timer ["interp"] in
+		let timer = Timer.start_timer ctx.timer_ctx ["interp"] in
 		let old = tctx.com.args in
 		tctx.com.args <- ctx.runtime_args;
 		let restore () =
@@ -200,8 +198,6 @@ let generate ctx tctx ext actx =
 		if name = "" then ()
 		else begin
 			Common.log com ("Generating " ^ name ^ ": " ^ com.file);
-			let t = Timer.timer ["generate";name] in
-			generate (Common.to_gctx com);
-			t()
+			Timer.time com.timer_ctx ["generate";name] generate (Common.to_gctx com);
 		end
 	end

+ 2 - 3
src/compiler/haxe.ml

@@ -43,12 +43,11 @@
 *)
 open Server
 
-let other = Timer.timer ["other"];;
+;;
 Sys.catch_break true;
 
 let args = List.tl (Array.to_list Sys.argv) in
 set_binary_mode_out stdout true;
 set_binary_mode_out stderr true;
 let sctx = ServerCompilationContext.create false in
-Server.process sctx (Communication.create_stdio ()) args;
-other()
+Server.process sctx (Communication.create_stdio ()) args;

+ 0 - 2
src/compiler/helper.ml

@@ -3,8 +3,6 @@ exception HelpMessage of string
 
 let is_debug_run = try Sys.getenv "HAXEDEBUG" = "1" with _ -> false
 
-let start_time = ref (Timer.get_time())
-
 let prompt = ref false
 
 let expand_env ?(h=None) path  =

+ 21 - 29
src/compiler/hxb/hxbLib.ml

@@ -2,7 +2,7 @@ open Globals
 open Common
 open ExtString
 
-class hxb_library file_path hxb_times = object(self)
+class hxb_library timer_ctx file_path hxb_times = object(self)
 	inherit abstract_hxb_lib
 	val zip = lazy (Zip.open_in file_path)
 
@@ -13,42 +13,34 @@ class hxb_library file_path hxb_times = object(self)
 	val mutable string_pool : string array option = None
 	val mutable macro_string_pool : string array option = None
 
+	method private do_load =
+		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));
+
 	method load =
 		if not loaded then begin
 			loaded <- true;
-			let close = Timer.timer ["hxblib";"read"] in
-			List.iter (function
-				| ({ Zip.filename = "StringPool.hxb" | "StringPool.macro.hxb" as filename} as entry) ->
-					let reader = new HxbReader.hxb_reader (["hxb";"internal"],"StringPool") (HxbReader.create_hxb_reader_stats()) None hxb_times in
-					let zip = Lazy.force zip in
-					let data = Bytes.unsafe_of_string (Zip.read_entry zip entry) in
-					ignore(reader#read (new HxbReaderApi.hxb_reader_api_null) data STR);
-					if filename = "StringPool.hxb" then
-						string_pool <- reader#get_string_pool
-					else
-						macro_string_pool <- reader#get_string_pool
-				| ({ 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();
+			Timer.time timer_ctx ["hxblib";"read"] (fun () -> self#do_load) ()
 		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();
+			let data = Timer.time timer_ctx ["hxblib";"get bytes"] (fun () ->
+				let zip = Lazy.force zip in
+				Zip.read_entry zip entry
+			) () in
 			Some (Bytes.unsafe_of_string data)
 		with Not_found ->
 			None
@@ -74,4 +66,4 @@ let create_hxb_lib com file_path =
 	with Not_found ->
 		failwith ("hxb lib " ^ file_path ^ " not found")
 	in
-	new hxb_library file (Common.defined com Define.HxbTimes)
+	new hxb_library com.timer_ctx file (if Common.defined com Define.HxbTimes then Some com.timer_ctx else None)

+ 6 - 13
src/compiler/hxb/hxbReader.ml

@@ -148,16 +148,14 @@ let dump_stats name stats =
 class hxb_reader
 	(mpath : path)
 	(stats : hxb_reader_stats)
-	(string_pool : string array option)
-	(timers_enabled : bool)
+	(timer_ctx : Timer.timer_context option)
 = object(self)
 	val mutable api = Obj.magic ""
 	val mutable full_restore = true
 	val mutable current_module = null_module
 
 	val mutable ch = BytesWithPosition.create (Bytes.create 0)
-	val mutable has_string_pool = (string_pool <> None)
-	val mutable string_pool = (match string_pool with None -> Array.make 0 "" | Some pool -> pool)
+	val mutable string_pool = Array.make 0 ""
 	val mutable doc_pool = Array.make 0 ""
 
 	val mutable classes = Array.make 0 (Lazy.from_val null_class)
@@ -190,12 +188,6 @@ class hxb_reader
 			dump_backtrace();
 			error (Printf.sprintf "[HXB] [%s] Cannot resolve type %s" (s_type_path current_module.m_path) (s_type_path ((pack @ [mname]),tname)))
 
-	method get_string_pool =
-		if has_string_pool then
-			Some (string_pool)
-		else
-			None
-
 	method make_lazy_type_dynamic f : Type.t =
 		api#make_lazy_type t_dynamic f
 
@@ -2015,11 +2007,9 @@ class hxb_reader
 		match kind with
 		| STR ->
 			string_pool <- self#read_string_pool;
-			has_string_pool <- true;
 		| DOC ->
 			doc_pool <- self#read_string_pool;
 		| MDF ->
-			assert(has_string_pool);
 			current_module <- self#read_mdf;
 			incr stats.modules_partially_restored;
 			if not full_restore then current_module.m_extra.m_display_deps <- Some PMap.empty
@@ -2084,7 +2074,10 @@ class hxb_reader
 	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 = if timers_enabled then Timer.timer id else fun() -> () in
+		let close = match timer_ctx with
+			| Some timer_ctx -> Timer.start_timer timer_ctx id
+			| None -> (fun () -> ())
+		in
 		try
 			self#read_chunk_data' kind
 		with Invalid_argument msg -> begin

+ 28 - 39
src/compiler/hxb/hxbWriter.ml

@@ -45,17 +45,6 @@ let unop_index op flag = match op,flag with
 	| NegBits,Postfix -> 10
 	| Spread,Postfix -> 11
 
-module StringHashtbl = Hashtbl.Make(struct
-	type t = string
-
-	let equal =
-		String.equal
-
-	let hash s =
-		(* What's the best here? *)
-		Hashtbl.hash s
-end)
-
 module Pool = struct
 	type ('key,'value) t = {
 		lut : ('key,int) Hashtbl.t;
@@ -408,9 +397,9 @@ type hxb_writer = {
 	config : HxbWriterConfig.writer_target_config;
 	warn : Warning.warning -> string -> Globals.pos -> unit;
 	anon_id : Type.t Tanon_identification.tanon_identification;
+	identified_anons : (tanon,int) IdentityPool.t;
 	mutable current_module : module_def;
 	chunks : Chunk.t DynArray.t;
-	has_own_string_pool : bool;
 	cp : StringPool.t;
 	docs : StringPool.t;
 	mutable chunk : Chunk.t;
@@ -1017,26 +1006,33 @@ module HxbWriter = struct
 		end
 
 	and write_anon_ref writer (an : tanon) =
-		let pfm = Option.get (writer.anon_id#identify_anon ~strict:true an) in
 		try
-			let index = Pool.get writer.anons pfm.pfm_path in
+			let index = IdentityPool.get writer.identified_anons an in
 			Chunk.write_u8 writer.chunk 0;
 			Chunk.write_uleb128 writer.chunk index
 		with Not_found ->
-			let restore = start_temporary_chunk writer 256 in
-			writer.needs_local_context <- false;
-			write_anon writer an;
-			let bytes = restore (fun new_chunk -> Chunk.get_bytes new_chunk) in
-			if writer.needs_local_context then begin
-				let index = Pool.add writer.anons pfm.pfm_path None in
-				Chunk.write_u8 writer.chunk 1;
-				Chunk.write_uleb128 writer.chunk index;
-				Chunk.write_bytes writer.chunk bytes
-			end else begin
-				let index = Pool.add writer.anons pfm.pfm_path (Some bytes) in
+			let pfm = writer.anon_id#identify_anon ~strict:true an in
+			try
+				let index = Pool.get writer.anons pfm.pfm_path in
 				Chunk.write_u8 writer.chunk 0;
-				Chunk.write_uleb128 writer.chunk index;
-			end
+				Chunk.write_uleb128 writer.chunk index
+			with Not_found ->
+				let restore = start_temporary_chunk writer 256 in
+				writer.needs_local_context <- false;
+				write_anon writer an;
+				let bytes = restore (fun new_chunk -> Chunk.get_bytes new_chunk) in
+				if writer.needs_local_context then begin
+					let index = Pool.add writer.anons pfm.pfm_path None in
+					ignore(IdentityPool.add writer.identified_anons an index);
+					Chunk.write_u8 writer.chunk 1;
+					Chunk.write_uleb128 writer.chunk index;
+					Chunk.write_bytes writer.chunk bytes
+				end else begin
+					let index = Pool.add writer.anons pfm.pfm_path (Some bytes) in
+					ignore(IdentityPool.add writer.identified_anons an index);
+					Chunk.write_u8 writer.chunk 0;
+					Chunk.write_uleb128 writer.chunk index;
+				end
 
 	and write_anon_field_ref writer cf =
 		try
@@ -2257,10 +2253,8 @@ module HxbWriter = struct
 		start_chunk writer EOF;
 		start_chunk writer EOM;
 
-		if writer.has_own_string_pool then begin
-			let a = StringPool.finalize writer.cp in
-			write_string_pool writer STR a
-		end;
+		let a = StringPool.finalize writer.cp in
+		write_string_pool writer STR a;
 		begin
 			let a = StringPool.finalize writer.docs in
 			if a.length > 0 then
@@ -2275,21 +2269,16 @@ module HxbWriter = struct
 		l
 end
 
-let create config string_pool warn anon_id =
-	let cp,has_own_string_pool = match string_pool with
-		| None ->
-			StringPool.create(),true
-		| Some pool ->
-			pool,false
-	in
+let create config warn anon_id =
+	let cp = StringPool.create() in
 	{
 		config;
 		warn;
 		anon_id;
+		identified_anons = IdentityPool.create();
 		current_module = null_module;
 		chunks = DynArray.create ();
 		cp = cp;
-		has_own_string_pool;
 		docs = StringPool.create ();
 		chunk = Obj.magic ();
 		classes = Pool.create ();

+ 0 - 2
src/compiler/hxb/hxbWriterConfig.ml

@@ -11,7 +11,6 @@ type writer_target_config = {
 
 type t = {
 	mutable archive_path : string;
-	mutable share_string_pool : bool;
 	target_config : writer_target_config;
 	macro_config : writer_target_config;
 }
@@ -26,7 +25,6 @@ let create_target_config () = {
 
 let create () = {
 	archive_path = "";
-	share_string_pool = true; (* Do we want this as default? *)
 	target_config = create_target_config ();
 	macro_config = create_target_config ()
 }

+ 14 - 14
src/compiler/messageReporting.ml

@@ -74,7 +74,7 @@ let create_error_context absolute_positions = {
 	previous = None;
 }
 
-let compiler_pretty_message_string com ectx cm =
+let compiler_pretty_message_string defines ectx cm =
 	match cm.cm_message with
 	(* Filter some messages that don't add much when using this message renderer *)
 	| "End of overload failure reasons" -> None
@@ -142,7 +142,7 @@ let compiler_pretty_message_string com ectx cm =
 
 		let gutter_len = (try String.length (Printf.sprintf "%d" (IntMap.find cm.cm_depth ectx.max_lines)) with Not_found -> 0) + 2 in
 
-		let no_color = Define.defined com.defines Define.MessageNoColor in
+		let no_color = Define.defined defines Define.MessageNoColor in
 		let c_reset = if no_color then "" else "\x1b[0m" in
 		let c_bold = if no_color then "" else "\x1b[1m" in
 		let c_dim = if no_color then "" else "\x1b[2m" in
@@ -316,21 +316,21 @@ let get_max_line max_lines messages =
 		else max_lines
 	) max_lines messages
 
-let display_source_at com p =
-	let absolute_positions = Define.defined com.defines Define.MessageAbsolutePositions in
+let display_source_at defines p =
+	let absolute_positions = Define.defined defines Define.MessageAbsolutePositions in
 	let ectx = create_error_context absolute_positions in
 	let msg = make_compiler_message "" p 0 MessageKind.DKCompilerMessage MessageSeverity.Information in
 	ectx.max_lines <- get_max_line ectx.max_lines [msg];
-	match compiler_pretty_message_string com ectx msg with
+	match compiler_pretty_message_string defines ectx msg with
 		| None -> ()
 		| Some s -> prerr_endline s
 
 exception ConfigError of string
 
-let get_formatter com def default =
-	let format_mode = Define.defined_value_safe ~default com.defines def in
+let get_formatter defines def default =
+	let format_mode = Define.defined_value_safe ~default defines def in
 	match format_mode with
-		| "pretty" -> compiler_pretty_message_string com
+		| "pretty" -> compiler_pretty_message_string defines
 		| "indent" -> compiler_indented_message_string
 		| "classic" -> compiler_message_string
 		| m -> begin
@@ -345,11 +345,11 @@ let print_error (err : Error.error) =
 	) err;
 	!ret
 
-let format_messages com messages =
-	let absolute_positions = Define.defined com.defines Define.MessageAbsolutePositions in
+let format_messages defines messages =
+	let absolute_positions = Define.defined defines Define.MessageAbsolutePositions in
 	let ectx = create_error_context absolute_positions in
 	ectx.max_lines <- get_max_line ectx.max_lines messages;
-	let message_formatter = get_formatter com Define.MessageReporting "pretty" in
+	let message_formatter = get_formatter defines Define.MessageReporting "pretty" in
 	let lines = List.rev (
 		List.fold_left (fun lines cm -> match (message_formatter ectx cm) with
 			| None -> lines
@@ -369,14 +369,14 @@ let display_messages ctx on_message = begin
 	in
 
 	let get_formatter _ def default =
-		try get_formatter ctx.com def default
+		try get_formatter ctx.com.defines def default
 		with | ConfigError s ->
 			error s;
 			compiler_message_string
 	in
 
-	let message_formatter = get_formatter ctx.com Define.MessageReporting "pretty" in
-	let log_formatter = get_formatter ctx.com Define.MessageLogFormat "indent" in
+	let message_formatter = get_formatter ctx.com.defines Define.MessageReporting "pretty" in
+	let log_formatter = get_formatter ctx.com.defines Define.MessageLogFormat "indent" in
 
 	let log_messages = ref (Define.defined ctx.com.defines Define.MessageLogFile) in
 	let log_message = ref None in

+ 24 - 37
src/compiler/server.ml

@@ -1,7 +1,6 @@
 open Globals
 open Common
 open CompilationCache
-open Timer
 open Type
 open DisplayProcessingGlobals
 open Ipaddr
@@ -54,16 +53,16 @@ let parse_file cs com (rfile : ClassPaths.resolved_file) p =
 		TypeloadParse.parse_file_from_string com file p stdin
 	| _ ->
 		let ftime = file_time ffile in
-		let data = Std.finally (Timer.timer ["server";"parser cache"]) (fun () ->
+		let data = Std.finally (Timer.start_timer com.timer_ctx ["server";"parser cache"]) (fun () ->
 			try
 				let cfile = cc#find_file fkey in
 				if cfile.c_time <> ftime then raise Not_found;
-				Parser.ParseSuccess((cfile.c_package,cfile.c_decls),false,cfile.c_pdi)
+				Parser.ParseSuccess((cfile.c_package,cfile.c_decls),cfile.c_pdi)
 			with Not_found ->
 				let parse_result = TypeloadParse.parse_file com rfile p in
 				let info,is_unusual = match parse_result with
 					| ParseError(_,_,_) -> "not cached, has parse error",true
-					| ParseSuccess(data,is_display_file,pdi) ->
+					| ParseSuccess(data,pdi) ->
 						if is_display_file then begin
 							if pdi.pd_errors <> [] then
 								"not cached, is display file with parse errors",true
@@ -76,7 +75,7 @@ let parse_file cs com (rfile : ClassPaths.resolved_file) p =
 							(* We assume that when not in display mode it's okay to cache stuff that has #if display
 							checks. The reasoning is that non-display mode has more information than display mode. *)
 							if com.display.dms_full_typing then raise Not_found;
-							let ident = Hashtbl.find Parser.special_identifier_files fkey in
+							let ident = ThreadSafeHashtbl.find com.parser_state.special_identifier_files fkey in
 							Printf.sprintf "not cached, using \"%s\" define" ident,true
 						with Not_found ->
 							cc#cache_file fkey (ClassPaths.create_resolved_file ffile rfile.class_path) ftime data pdi;
@@ -113,10 +112,9 @@ module Communication = struct
 				end;
 				flush stdout;
 			);
-			exit = (fun code ->
+			exit = (fun timer_ctx code ->
 				if code = 0 then begin
-					Timer.close_times();
-					if !Timer.measure_times then Timer.report_times (fun s -> self.write_err (s ^ "\n"));
+					if timer_ctx.measure_times = Yes then Timer.report_times timer_ctx (fun s -> self.write_err (s ^ "\n"));
 				end;
 				exit code;
 			);
@@ -141,15 +139,13 @@ module Communication = struct
 
 					sctx.was_compilation <- ctx.com.display.dms_full_typing;
 					if has_error ctx then begin
-						measure_times := false;
+						ctx.timer_ctx.measure_times <- No;
 						write "\x02\n"
-					end else begin
-						Timer.close_times();
-						if !Timer.measure_times then Timer.report_times (fun s -> self.write_err (s ^ "\n"));
-					end
+					end else
+						if ctx.timer_ctx.measure_times = Yes then Timer.report_times ctx.timer_ctx (fun s -> self.write_err (s ^ "\n"));
 				)
 			);
-			exit = (fun i ->
+			exit = (fun timer_ctx i ->
 				()
 			);
 			is_server = true;
@@ -163,7 +159,6 @@ let stat dir =
 
 (* Gets a list of changed directories for the current compilation. *)
 let get_changed_directories sctx com =
-	let t = Timer.timer ["server";"module cache";"changed dirs"] in
 	let cs = sctx.cs in
 	let sign = Define.get_signature com.defines in
 	let dirs = try
@@ -223,9 +218,11 @@ let get_changed_directories sctx com =
 		Hashtbl.add sctx.changed_directories sign dirs;
 		dirs
 	in
-	t();
 	dirs
 
+let get_changed_directories sctx com =
+	Timer.time com.Common.timer_ctx ["server";"module cache";"changed dirs"] (get_changed_directories sctx) com
+
 let full_typing com m_extra =
 	com.is_macro_context
 	|| com.display.dms_full_typing
@@ -298,7 +295,7 @@ let check_module sctx com m_path m_extra p =
 				end
 		in
 		let has_policy policy = List.mem policy m_extra.m_check_policy || match policy with
-			| NoFileSystemCheck when !ServerConfig.do_not_check_modules && !Parser.display_mode <> DMNone -> true
+			| NoFileSystemCheck when !ServerConfig.do_not_check_modules && com.display.dms_kind <> DMNone -> true
 			| _ -> false
 		in
 		let check_file () =
@@ -438,14 +435,12 @@ class hxb_reader_api_server
 		| GoodModule m ->
 			m
 		| BinaryModule mc ->
-			let reader = new HxbReader.hxb_reader path com.hxb_reader_stats (Some cc#get_string_pool_arr) (Common.defined com Define.HxbTimes) in
+			let reader = new HxbReader.hxb_reader path com.hxb_reader_stats (if Common.defined com Define.HxbTimes then Some com.timer_ctx else None) in
 			let full_restore = full_typing com mc.mc_extra in
 			let f_next chunks until =
 				let macro = if com.is_macro_context then " (macro)" else "" in
-				let t_hxb = Timer.timer ["server";"module cache";"hxb read" ^ macro;"until " ^ (string_of_chunk_kind until)] in
-				let r = reader#read_chunks_until (self :> HxbReaderApi.hxb_reader_api) chunks until full_restore in
-				t_hxb();
-				r
+				let f  = reader#read_chunks_until (self :> HxbReaderApi.hxb_reader_api) chunks until in
+				Timer.time com.timer_ctx ["server";"module cache";"hxb read" ^ macro;"until " ^ (string_of_chunk_kind until)] f full_restore
 			in
 
 			let m,chunks = f_next mc.mc_chunks EOT in
@@ -539,23 +534,18 @@ let rec add_modules sctx com delay (m : module_def) (from_binary : bool) (p : po
 (* Looks up the module referred to by [mpath] in the cache. If it exists, a check is made to
    determine if it's still valid. If this function returns None, the module is re-typed. *)
 and type_module sctx com delay mpath p =
-	let t = Timer.timer ["server";"module cache"] in
+	let t = Timer.start_timer com.timer_ctx ["server";"module cache"] in
 	let cc = CommonCache.get_cache com in
 	let skip m_path reason =
 		ServerMessage.skipping_dep com "" (m_path,(Printer.s_module_skip_reason reason));
 		BadModule reason
 	in
 	let add_modules from_binary m =
-		let tadd = Timer.timer ["server";"module cache";"add modules"] in
-		add_modules sctx com delay m from_binary p;
-		tadd();
+		Timer.time com.timer_ctx ["server";"module cache";"add modules"] (add_modules sctx com delay m from_binary) p;
 		GoodModule m
 	in
 	let check_module sctx m_path m_extra p =
-		let tcheck = Timer.timer ["server";"module cache";"check"] in
-		let r = check_module sctx com mpath m_extra p in
-		tcheck();
-		r
+		Timer.time com.timer_ctx ["server";"module cache";"check"] (check_module sctx com mpath m_extra) p
 	in
 	let find_module_in_cache cc m_path p =
 		try
@@ -582,7 +572,7 @@ and type_module sctx com delay mpath p =
 			   checking dependencies. This means that the actual decoding never has any reason to fail. *)
 			begin match check_module sctx mpath mc.mc_extra p with
 				| None ->
-					let reader = new HxbReader.hxb_reader mpath com.hxb_reader_stats (Some cc#get_string_pool_arr) (Common.defined com Define.HxbTimes) in
+					let reader = new HxbReader.hxb_reader mpath com.hxb_reader_stats (if Common.defined com Define.HxbTimes then Some com.timer_ctx else None) in
 					let full_restore = full_typing com mc.mc_extra in
 					let api = match com.hxb_reader_api with
 						| Some api ->
@@ -594,10 +584,7 @@ and type_module sctx com delay mpath p =
 					in
 					let f_next chunks until =
 						let macro = if com.is_macro_context then " (macro)" else "" in
-						let t_hxb = Timer.timer ["server";"module cache";"hxb read" ^ macro;"until " ^ (string_of_chunk_kind until)] in
-						let r = reader#read_chunks_until api chunks until full_restore in
-						t_hxb();
-						r
+						Timer.time com.timer_ctx ["server";"module cache";"hxb read" ^ macro;"until " ^ (string_of_chunk_kind until)] (reader#read_chunks_until api chunks until) full_restore
 					in
 
 					let m,chunks = f_next mc.mc_chunks EOT in
@@ -785,7 +772,7 @@ let enable_cache_mode sctx =
 	TypeloadParse.parse_hook := parse_file sctx.cs
 
 let rec process sctx comm args =
-	let t0 = get_time() in
+	let t0 = Extc.time() in
 	ServerMessage.arguments args;
 	reset sctx;
 	let api = {
@@ -808,7 +795,7 @@ let rec process sctx comm args =
 	} in
 	Compiler.HighLevel.entry api comm args;
 	run_delays sctx;
-	ServerMessage.stats stats (get_time() -. t0)
+	ServerMessage.stats stats (Extc.time() -. t0)
 
 (* The server main loop. Waits for the [accept] call to then process the sent compilation
    parameters through [process_params]. *)

+ 2 - 10
src/compiler/serverCompilationContext.ml

@@ -1,5 +1,4 @@
 open Common
-open Timer
 open CompilationCache
 
 type t = {
@@ -45,22 +44,15 @@ let reset sctx =
 	Hashtbl.clear sctx.changed_directories;
 	sctx.was_compilation <- false;
 	Parser.reset_state();
-	Lexer.cur := Lexer.make_file "";
-	measure_times := false;
 	Hashtbl.clear DeprecationCheck.warned_positions;
-	close_times();
 	stats.s_files_parsed := 0;
 	stats.s_classes_built := 0;
 	stats.s_methods_typed := 0;
-	stats.s_macros_called := 0;
-	Hashtbl.clear Timer.htimers;
-	Helper.start_time := get_time()
+	stats.s_macros_called := 0
 
 let maybe_cache_context sctx com =
 	if com.display.dms_full_typing && com.display.dms_populate_cache then begin
-		let t = Timer.timer ["server";"cache context"] in
-		CommonCache.cache_context sctx.cs com;
-		t();
+		Timer.time com.timer_ctx ["server";"cache context"] (CommonCache.cache_context sctx.cs) com;
 		ServerMessage.cached_modules com "" (List.length com.modules);
 	end
 

+ 2 - 2
src/compiler/tasks.ml

@@ -6,7 +6,7 @@ class gc_task (max_working_memory : float) (heap_size : float) = object(self)
 	inherit server_task ["gc"] 100
 
 	method private execute =
-		let t0 = Timer.get_time() in
+		let t0 = Extc.time() in
 		let stats = Gc.stat() in
 		let live_words = float_of_int stats.live_words in
 		(* Maximum heap size needed for the last X compilations = sum of what's live + max working memory. *)
@@ -27,7 +27,7 @@ class gc_task (max_working_memory : float) (heap_size : float) = object(self)
 			Gc.full_major();
 		end;
 		Gc.set old_gc;
-		ServerMessage.gc_stats (Timer.get_time() -. t0) stats do_compact new_space_overhead
+		ServerMessage.gc_stats (Extc.time() -. t0) stats do_compact new_space_overhead
 end
 
 class class_maintenance_task (cs : CompilationCache.t) (c : tclass) = object(self)

+ 18 - 19
src/context/abstractCast.ml

@@ -7,6 +7,7 @@ open Error
 
 let cast_stack = new_rec_stack()
 
+
 let rec make_static_call ctx c cf a pl args t p =
 	if cf.cf_kind = Method MethMacro then begin
 		match args with
@@ -110,7 +111,7 @@ and do_check_cast ctx uctx tleft eright p =
 
 and cast_or_unify_raise ctx ?(uctx=None) tleft eright p =
 	let uctx = match uctx with
-		| None -> default_unification_context
+		| None -> default_unification_context ()
 		| Some uctx -> uctx
 	in
 	try
@@ -199,11 +200,11 @@ let find_array_write_access ctx a tl e1 e2 p =
 		let s_type = s_type (print_context()) in
 		raise_typing_error (Printf.sprintf "No @:arrayAccess function for %s accepts arguments of %s and %s" (s_type (TAbstract(a,tl))) (s_type e1.etype) (s_type e2.etype)) p
 
-let find_multitype_specialization' com a pl p =
-	let uctx = default_unification_context in
+let find_multitype_specialization' platform a pl p =
+	let uctx = default_unification_context () in
 	let m = mk_mono() in
 	let tl,definitive_types = Abstract.find_multitype_params a pl in
-	if com.platform = Globals.Js && a.a_path = (["haxe";"ds"],"Map") then begin match tl with
+	if platform = Globals.Js && a.a_path = (["haxe";"ds"],"Map") then begin match tl with
 		| t1 :: _ ->
 			let stack = ref [] in
 			let rec loop t =
@@ -243,11 +244,11 @@ let find_multitype_specialization' com a pl p =
 	in
 	cf,follow m,tl
 
-let find_multitype_specialization com a pl p =
-	let cf,m,_ = find_multitype_specialization' com a pl p in
+let find_multitype_specialization platform a pl p =
+	let cf,m,_ = find_multitype_specialization' platform a pl p in
 	(cf,m)
 
-let handle_abstract_casts ctx e =
+let handle_abstract_casts (scom : SafeCom.t) e =
 	let rec loop e = match e.eexpr with
 		| TNew({cl_kind = KAbstractImpl a} as c,pl,el) ->
 			if not (Meta.has Meta.MultiType a.a_meta) then begin
@@ -258,24 +259,22 @@ let handle_abstract_casts ctx e =
 				| _ -> raise_typing_error ("Cannot construct " ^ (s_type (print_context()) (TAbstract(a,pl)))) e.epos
 			end else begin
 				(* a TNew of an abstract implementation is only generated if it is a multi type abstract *)
-				let cf,m,pl = find_multitype_specialization' ctx.com a pl e.epos in
-				let e = make_static_call ctx c cf a pl ((mk (TConst TNull) (TAbstract(a,pl)) e.epos) :: el) m e.epos in
+				let cf,m,pl = find_multitype_specialization' scom.platform a pl e.epos in
+				let e = ExceptionFunctions.make_static_call scom c cf ((mk (TConst TNull) (TAbstract(a,pl)) e.epos) :: el)  m e.epos in
 				{e with etype = m}
 			end
 		| TCall({eexpr = TField(_,FStatic({cl_path=[],"Std"},{cf_name = "string"}))},[e1]) when (match follow e1.etype with TAbstract({a_impl = Some _},_) -> true | _ -> false) ->
 			begin match follow e1.etype with
-				| TAbstract({a_impl = Some c} as a,tl) ->
+				| TAbstract({a_impl = Some c},tl) ->
 					begin try
 						let cf = PMap.find "toString" c.cl_statics in
-						let call() = make_static_call ctx c cf a tl [e1] ctx.t.tstring e.epos in
-						if not ctx.allow_transform then
-							{ e1 with etype = ctx.t.tstring; epos = e.epos }
-						else if not (is_nullable e1.etype) then
+						let call() = ExceptionFunctions.make_static_call scom c cf [e1] scom.basic.tstring e.epos in
+						if not (is_nullable e1.etype) then
 							call()
 						else begin
 							let p = e.epos in
-							let chk_null = mk (TBinop (Ast.OpEq, e1, mk (TConst TNull) e1.etype p)) ctx.com.basic.tbool p in
-							mk (TIf (chk_null, mk (TConst (TString "null")) ctx.com.basic.tstring p, Some (call()))) ctx.com.basic.tstring p
+							let chk_null = mk (TBinop (Ast.OpEq, e1, mk (TConst TNull) e1.etype p)) scom.basic.tbool p in
+							mk (TIf (chk_null, mk (TConst (TString "null")) scom.basic.tstring p, Some (call()))) scom.basic.tstring p
 						end
 					with Not_found ->
 						e
@@ -343,14 +342,14 @@ let handle_abstract_casts ctx e =
 								else
 									el
 							in
-							let ecall = make_call ctx ef el tr e.epos in
+							let ecall = ExceptionFunctions.make_call scom ef el tr e.epos in
 							maybe_cast ecall e.etype e.epos
 						with Not_found ->
 							(* quick_field raises Not_found if m is an abstract, we have to replicate the 'using' call here *)
 							match follow m with
-							| TAbstract({a_impl = Some c} as a,pl) ->
+							| TAbstract({a_impl = Some c},pl) ->
 								let cf = PMap.find fname c.cl_statics in
-								make_static_call ctx c cf a pl (e2 :: el) e.etype e.epos
+								ExceptionFunctions.make_static_call scom c cf  (e2 :: el) e.etype e.epos
 							| _ -> raise Not_found
 						end
 					| _ ->

+ 29 - 138
src/context/common.ml

@@ -45,127 +45,6 @@ type stats = {
 	s_macros_called : int ref;
 }
 
-(**
-	The capture policy tells which handling we make of captured locals
-	(the locals which are referenced in local functions)
-
-	See details/implementation in Codegen.captured_vars
-*)
-type capture_policy =
-	(** do nothing, let the platform handle it *)
-	| CPNone
-	(** wrap all captured variables into a single-element array to allow modifications *)
-	| CPWrapRef
-	(** similar to wrap ref, but will only apply to the locals that are declared in loops *)
-	| CPLoopVars
-
-type exceptions_config = {
-	(* Base types which may be thrown from Haxe code without wrapping. *)
-	ec_native_throws : path list;
-	(* Base types which may be caught from Haxe code without wrapping. *)
-	ec_native_catches : path list;
-	(*
-		Hint exceptions filter to avoid wrapping for targets, which can throw/catch any type
-		Ignored on targets with a specific native base type for exceptions.
-	*)
-	ec_avoid_wrapping : bool;
-	(* Path of a native class or interface, which can be used for wildcard catches. *)
-	ec_wildcard_catch : path;
-	(*
-		Path of a native base class or interface, which can be thrown.
-		This type is used to cast `haxe.Exception.thrown(v)` calls to.
-		For example `throw 123` is compiled to `throw (cast Exception.thrown(123):ec_base_throw)`
-	*)
-	ec_base_throw : path;
-	(*
-		Checks if throwing this expression is a special case for current target
-		and should not be modified.
-	*)
-	ec_special_throw : texpr -> bool;
-}
-
-type var_scope =
-	| FunctionScope
-	| BlockScope
-
-type var_scoping_flags =
-	(**
-		Variables are hoisted in their scope
-	*)
-	| VarHoisting
-	(**
-		It's not allowed to shadow existing variables in a scope.
-	*)
-	| NoShadowing
-	(**
-		It's not allowed to shadow a `catch` variable.
-	*)
-	| NoCatchVarShadowing
-	(**
-		Local vars cannot have the same name as the current top-level package or
-		(if in the root package) current class name
-	*)
-	| ReserveCurrentTopLevelSymbol
-	(**
-		Local vars cannot have a name used for any top-level symbol
-		(packages and classes in the root package)
-	*)
-	| ReserveAllTopLevelSymbols
-	(**
-		Reserve all type-paths converted to "flat path" with `Path.flat_path`
-	*)
-	| ReserveAllTypesFlat
-	(**
-		List of names cannot be taken by local vars
-	*)
-	| ReserveNames of string list
-	(**
-		Cases in a `switch` won't have blocks, but will share the same outer scope.
-	*)
-	| SwitchCasesNoBlocks
-
-type var_scoping_config = {
-	vs_flags : var_scoping_flags list;
-	vs_scope : var_scope;
-}
-
-type platform_config = {
-	(** has a static type system, with not-nullable basic types (Int/Float/Bool) *)
-	pf_static : bool;
-	(** has access to the "sys" package *)
-	pf_sys : bool;
-	(** captured variables handling (see before) *)
-	pf_capture_policy : capture_policy;
-	(** when calling a method with optional args, do we replace the missing args with "null" constants *)
-	pf_pad_nulls : bool;
-	(** add a final return to methods not having one already - prevent some compiler warnings *)
-	pf_add_final_return : bool;
-	(** does the platform natively support overloaded functions *)
-	pf_overload : bool;
-	(** can the platform use default values for non-nullable arguments *)
-	pf_can_skip_non_nullable_argument : bool;
-	(** type paths that are reserved on the platform *)
-	pf_reserved_type_paths : path list;
-	(** supports function == function **)
-	pf_supports_function_equality : bool;
-	(** uses utf16 encoding with ucs2 api **)
-	pf_uses_utf16 : bool;
-	(** target supports accessing `this` before calling `super(...)` **)
-	pf_this_before_super : bool;
-	(** target supports threads **)
-	pf_supports_threads : bool;
-	(** target supports Unicode **)
-	pf_supports_unicode : bool;
-	(** target supports rest arguments **)
-	pf_supports_rest_args : bool;
-	(** exceptions handling config **)
-	pf_exceptions : exceptions_config;
-	(** the scoping of local variables *)
-	pf_scoping : var_scoping_config;
-	(** target supports atomic operations via haxe.Atomic **)
-	pf_supports_atomics : bool;
-}
-
 class compiler_callbacks = object(self)
 	val before_typer_create = ref [];
 	val after_init_macros = ref [];
@@ -348,6 +227,13 @@ class virtual abstract_hxb_lib = object(self)
 	method virtual get_string_pool : string -> string array option
 end
 
+type parser_state = {
+	mutable was_auto_triggered : bool;
+	mutable had_parser_resume : bool;
+	delayed_syntax_completion : Parser.syntax_completion_on option Atomic.t;
+	special_identifier_files : (Path.UniqueKey.t,string) ThreadSafeHashtbl.t;
+}
+
 type context = {
 	compilation_step : int;
 	mutable stage : compiler_stage;
@@ -355,6 +241,7 @@ type context = {
 	mutable cache : CompilationCache.context_cache option;
 	is_macro_context : bool;
 	mutable json_out : json_api option;
+	timer_ctx : Timer.timer_context;
 	(* config *)
 	version : compiler_version;
 	mutable args : string list;
@@ -362,13 +249,15 @@ type context = {
 	mutable debug : bool;
 	mutable verbose : bool;
 	mutable foptimize : bool;
+	mutable doinline : bool;
 	mutable platform : platform;
-	mutable config : platform_config;
+	mutable config : PlatformConfig.platform_config;
 	empty_class_path : ClassPath.class_path;
 	class_paths : ClassPaths.class_paths;
 	main : Gctx.context_main;
 	mutable package_rules : (string,package_rule) PMap.t;
 	mutable report_mode : report_mode;
+	parser_state : parser_state;
 	(* communication *)
 	mutable print : string -> unit;
 	mutable error : Gctx.error_function;
@@ -452,8 +341,8 @@ let to_gctx com = {
 		| _ -> []);
 	include_files = com.include_files;
 	std = com.std;
+	timer_ctx = com.timer_ctx;
 }
-
 let enter_stage com stage =
 	(* print_endline (Printf.sprintf "Entering stage %s" (s_compiler_stage stage)); *)
 	com.stage <- stage
@@ -565,6 +454,8 @@ let stats =
 		s_macros_called = ref 0;
 	}
 
+open PlatformConfig
+
 let default_config =
 	{
 		pf_static = true;
@@ -792,11 +683,12 @@ let get_config com =
 
 let memory_marker = [|Unix.time()|]
 
-let create compilation_step cs version args display_mode =
+let create timer_ctx compilation_step cs version args display_mode =
 	let rec com = {
 		compilation_step = compilation_step;
 		cs = cs;
 		cache = None;
+		timer_ctx = timer_ctx;
 		stage = CCreated;
 		version = version;
 		args = args;
@@ -814,6 +706,7 @@ let create compilation_step cs version args display_mode =
 		display = display_mode;
 		verbose = false;
 		foptimize = true;
+		doinline = true;
 		features = Hashtbl.create 0;
 		platform = Cross;
 		config = default_config;
@@ -823,7 +716,8 @@ let create compilation_step cs version args display_mode =
 		empty_class_path = new ClassPath.directory_class_path "" User;
 		class_paths = new ClassPaths.class_paths;
 		main = {
-			main_class = None;
+			main_path = None;
+			main_file = None;
 			main_expr = None;
 		};
 		package_rules = PMap.empty;
@@ -845,10 +739,7 @@ let create compilation_step cs version args display_mode =
 		include_files = [];
 		js_gen = None;
 		load_extern_type = [];
-		defines = {
-			defines_signature = None;
-			values = PMap.empty;
-		};
+		defines = Define.empty_defines ();
 		user_defines = Hashtbl.create 0;
 		user_metas = Hashtbl.create 0;
 		get_macros = (fun() -> None);
@@ -888,6 +779,12 @@ let create compilation_step cs version args display_mode =
 		hxb_reader_api = None;
 		hxb_reader_stats = HxbReader.create_hxb_reader_stats ();
 		hxb_writer_config = None;
+		parser_state = {
+			was_auto_triggered = false;
+			had_parser_resume = false;
+			delayed_syntax_completion = Atomic.make None;
+			special_identifier_files = ThreadSafeHashtbl.create 0;
+		}
 	} in
 	com
 
@@ -919,7 +816,8 @@ let clone com is_macro_context =
 			tstring = mk_mono();
 		};
 		main = {
-			main_class = None;
+			main_path = None;
+			main_file = None;
 			main_expr = None;
 		};
 		features = Hashtbl.create 0;
@@ -1087,10 +985,6 @@ let platform_name_macro com =
 let find_file ctx f =
 	(ctx.class_paths#find_file f).file
 
-(* let find_file ctx f =
-	let timer = Timer.timer ["find_file"] in
-	Std.finally timer (find_file ctx) f *)
-
 let mem_size v =
 	Objsize.size_with_headers (Objsize.objsize v [] [])
 
@@ -1117,9 +1011,6 @@ let display_error_ext com err =
 let display_error com ?(depth = 0) msg p =
 	display_error_ext com (Error.make_error ~depth (Custom msg) p)
 
-let dump_path com =
-	Define.defined_value_safe ~default:"dump" com.defines Define.DumpPath
-
 let adapt_defines_to_macro_context defines =
 	let to_remove = "java" :: List.map Globals.platform_name Globals.platforms in
 	let to_remove = List.fold_left (fun acc d -> Define.get_define_key d :: acc) to_remove [Define.NoTraces] in
@@ -1152,7 +1043,7 @@ let get_entry_point com =
 		in
 		let e = Option.get com.main.main_expr in (* must be present at this point *)
 		(snd path, c, e)
-	) com.main.main_class
+	) com.main.main_path
 
 let make_unforced_lazy t_proc f where =
 	let r = ref (lazy_available t_dynamic) in

+ 21 - 14
src/context/commonCache.ml

@@ -85,14 +85,12 @@ let rec cache_context cs com =
 	let cc = get_cache com in
 	let sign = Define.get_signature com.defines in
 
-	let cache_module =
+	let parallels = DynArray.create () in
+	let cache_module m =
 		if Define.defined com.defines DisableHxbCache then
-			let cache_module m =
-				(* If we have a signature mismatch, look-up cache for module. Physical equality check is fine as a heuristic. *)
-				let cc = if m.m_extra.m_sign = sign then cc else cs#get_context m.m_extra.m_sign in
-				cc#cache_module_in_memory m.m_path m;
-			in
-			cache_module
+			(* If we have a signature mismatch, look-up cache for module. Physical equality check is fine as a heuristic. *)
+			let cc = if m.m_extra.m_sign = sign then cc else cs#get_context m.m_extra.m_sign in
+			cc#cache_module_in_memory m.m_path m;
 		else
 			let anon_identification = new Tanon_identification.tanon_identification in
 			let warn w s p = com.warning w com.warning_options s p in
@@ -102,15 +100,24 @@ let rec cache_context cs com =
 				| Some config ->
 					if com.is_macro_context then config.macro_config else config.target_config
 			in
-			let cache_module m =
-				(* If we have a signature mismatch, look-up cache for module. Physical equality check is fine as a heuristic. *)
-				let cc = if m.m_extra.m_sign = sign then cc else cs#get_context m.m_extra.m_sign in
-				cc#cache_hxb_module config warn anon_identification m.m_path m;
-			in
-			cache_module
+			(* If we have a signature mismatch, look-up cache for module. Physical equality check is fine as a heuristic. *)
+			let cc = if m.m_extra.m_sign = sign then cc else cs#get_context m.m_extra.m_sign in
+			match cc#cache_hxb_module config warn anon_identification m with
+			| None ->
+				()
+			| Some f ->
+				DynArray.add parallels (cc,m,f)
 	in
-
 	List.iter cache_module com.modules;
+	let a = Parallel.run_in_new_pool com.timer_ctx (fun pool ->
+		Parallel.ParallelArray.map pool (fun (cc,m,f) ->
+			let chunks = f() in
+			(cc,m,chunks)
+		) (DynArray.to_array parallels) (cc,null_module,[])
+	) in
+	Array.iter (fun (cc,m,chunks) ->
+		cc#add_binary_cache m chunks
+	) a;
 	begin match com.get_macros() with
 		| None -> ()
 		| Some com -> cache_context cs com

+ 2 - 2
src/context/display/display.ml

@@ -31,8 +31,8 @@ module ReferencePosition = struct
 end
 
 let preprocess_expr com e = match com.display.dms_kind with
-	| DMDefinition | DMTypeDefinition | DMUsage _ | DMImplementation | DMHover | DMDefault -> ExprPreprocessing.find_before_pos com.display.dms_kind e
-	| DMSignature -> ExprPreprocessing.find_display_call e
+	| DMDefinition | DMTypeDefinition | DMUsage _ | DMImplementation | DMHover | DMDefault -> ExprPreprocessing.find_before_pos com.parser_state.was_auto_triggered com.display.dms_kind e
+	| DMSignature -> ExprPreprocessing.find_display_call com.parser_state.was_auto_triggered e
 	| _ -> e
 
 let sort_fields l with_type tk =

+ 5 - 7
src/context/display/displayJson.ml

@@ -51,7 +51,6 @@ class display_handler (jsonrpc : jsonrpc_handler) com (cs : CompilationCache.t)
 
 	method enable_display ?(skip_define=false) mode =
 		com.display <- create mode;
-		Parser.display_mode := mode;
 		if not skip_define then Common.define_value com Define.Display "1"
 
 	method set_display_file was_auto_triggered requires_offset =
@@ -65,7 +64,7 @@ class display_handler (jsonrpc : jsonrpc_handler) com (cs : CompilationCache.t)
 		) None in
 
 		let pos = if requires_offset then jsonrpc#get_int_param "offset" else (-1) in
-		Parser.was_auto_triggered := was_auto_triggered;
+		com.parser_state.was_auto_triggered <- was_auto_triggered;
 
 		if file <> file_input_marker then begin
 			let file_unique = com.file_keys#get file in
@@ -139,7 +138,7 @@ class hxb_reader_api_com
 			cc#find_module m_path
 		with Not_found ->
 			let mc = cc#get_hxb_module m_path in
-			let reader = new HxbReader.hxb_reader mc.mc_path com.hxb_reader_stats (Some cc#get_string_pool_arr) (Common.defined com Define.HxbTimes) in
+			let reader = new HxbReader.hxb_reader mc.mc_path com.hxb_reader_stats (if Common.defined com Define.HxbTimes then Some com.timer_ctx else None) in
 			fst (reader#read_chunks_until (self :> HxbReaderApi.hxb_reader_api) mc.mc_chunks (if full_restore then EOM else MTF) full_restore)
 
 	method basic_types =
@@ -493,7 +492,7 @@ let handler =
 	List.iter (fun (s,f) -> Hashtbl.add h s f) l;
 	h
 
-let parse_input com input report_times =
+let parse_input com input =
 	let input =
 		JsonRpc.handle_jsonrpc_error (fun () -> JsonRpc.parse_request input) send_json
 	in
@@ -506,9 +505,8 @@ let parse_input com input report_times =
 			"result",json;
 			"timestamp",jfloat (Unix.gettimeofday ());
 		] in
-		let fl = if !report_times then begin
-			close_times();
-			let _,_,root = Timer.build_times_tree () in
+		let fl = if com.timer_ctx.measure_times = Yes then begin
+			let _,_,root = Timer.build_times_tree com.timer_ctx in
 			begin match json_of_times root with
 			| None -> fl
 			| Some jo -> ("timers",jo) :: fl

+ 1 - 1
src/context/display/displayTexpr.ml

@@ -178,7 +178,7 @@ let check_display_file ctx cs =
 				| NoModule | BadModule _ -> raise Not_found
 				| BinaryModule mc ->
 					let api = (new TypeloadModule.hxb_reader_api_typeload ctx.com ctx.g TypeloadModule.load_module' p :> HxbReaderApi.hxb_reader_api) in
-					let reader = new HxbReader.hxb_reader path ctx.com.hxb_reader_stats (Some cc#get_string_pool_arr) (Common.defined ctx.com Define.HxbTimes) in
+					let reader = new HxbReader.hxb_reader path ctx.com.hxb_reader_stats (if Common.defined ctx.com Define.HxbTimes then Some ctx.com.timer_ctx else None) in
 					let m = reader#read_chunks api mc.mc_chunks in
 					m
 				| GoodModule m ->

+ 211 - 211
src/context/display/displayToplevel.ml

@@ -109,20 +109,20 @@ end
 
 let explore_class_paths com timer class_paths recursive f_pack f_module =
 	let cs = com.cs in
-	let t = Timer.timer (timer @ ["class path exploration"]) in
-	let checked = Hashtbl.create 0 in
-	let tasks = ExtList.List.filter_map (fun path ->
-		match path#get_directory_path with
-			| Some path ->
-				Some (new explore_class_path_task com checked recursive f_pack f_module path [])
-			| None ->
-				None
-	) class_paths in
-	let task = new arbitrary_task ["explore"] 50 (fun () ->
-		List.iter (fun task -> task#run) tasks
-	) in
-	cs#add_task task;
-	t()
+	Timer.time com.timer_ctx (timer @ ["class path exploration"]) (fun () ->
+		let checked = Hashtbl.create 0 in
+		let tasks = ExtList.List.filter_map (fun path ->
+			match path#get_directory_path with
+				| Some path ->
+					Some (new explore_class_path_task com checked recursive f_pack f_module path [])
+				| None ->
+					None
+		) class_paths in
+		let task = new arbitrary_task ["explore"] 50 (fun () ->
+			List.iter (fun task -> task#run) tasks
+		) in
+		cs#add_task task;
+	) ()
 
 let read_class_paths com timer =
 	explore_class_paths com timer (com.class_paths#filter (fun cp -> cp#path <> "")) true (fun _ -> ()) (fun file path ->
@@ -225,7 +225,6 @@ let is_pack_visible pack =
 	not (List.exists (fun s -> String.length s > 0 && s.[0] = '_') pack)
 
 let collect ctx tk with_type sort =
-	let t = Timer.timer ["display";"toplevel collect"] in
 	let cctx = CollectionContext.create ctx in
 	let curpack = fst ctx.c.curclass.cl_path in
 	(* Note: This checks for the explicit `ServerConfig.legacy_completion` setting instead of using
@@ -298,12 +297,12 @@ let collect ctx tk with_type sort =
 	| TKType | TKOverride -> ()
 	| TKExpr p | TKPattern p | TKField p ->
 		(* locals *)
-		let t = Timer.timer ["display";"toplevel collect";"locals"] in
-		PMap.iter (fun _ v ->
-			if not (is_gen_local v) then
-				add (make_ci_local v (tpair ~values:(get_value_meta v.v_meta) v.v_type)) (Some v.v_name)
-		) ctx.f.locals;
-		t();
+		Timer.time ctx.com.timer_ctx ["display";"toplevel collect";"locals"] (fun () ->
+			PMap.iter (fun _ v ->
+				if not (is_gen_local v) then
+					add (make_ci_local v (tpair ~values:(get_value_meta v.v_meta) v.v_type)) (Some v.v_name)
+			) ctx.f.locals;
+		) ();
 
 		let add_field scope origin cf =
 			let origin,cf = match origin with
@@ -329,137 +328,137 @@ let collect ctx tk with_type sort =
 			if not (Meta.has Meta.NoCompletion cf.cf_meta) then add_field scope origin cf
 		in
 
-		let t = Timer.timer ["display";"toplevel collect";"fields"] in
-		(* member fields *)
-		if ctx.e.curfun <> FunStatic then begin
-			let all_fields = Type.TClass.get_all_fields ctx.c.curclass (extract_param_types ctx.c.curclass.cl_params) in
-			PMap.iter (fun _ (c,cf) ->
-				let origin = if c == ctx.c.curclass then Self (TClassDecl c) else Parent (TClassDecl c) in
-				maybe_add_field CFSMember origin cf
-			) all_fields;
-			(* TODO: local using? *)
-		end;
-
-		(* statics *)
-		begin match ctx.c.curclass.cl_kind with
-		| KAbstractImpl ({a_impl = Some c} as a) ->
-			let origin = Self (TAbstractDecl a) in
-			List.iter (fun cf ->
-				if has_class_field_flag cf CfImpl then begin
-					if ctx.e.curfun = FunStatic then ()
-					else begin
-						let cf = prepare_using_field cf in
-						maybe_add_field CFSMember origin cf
-					end
-				end else
-					maybe_add_field CFSStatic origin cf
-			) c.cl_ordered_statics
-		| _ ->
-			List.iter (maybe_add_field CFSStatic (Self (TClassDecl ctx.c.curclass))) ctx.c.curclass.cl_ordered_statics
-		end;
-		t();
-
-		let t = Timer.timer ["display";"toplevel collect";"enum ctors"] in
-		(* enum constructors *)
-		let rec enum_ctors t =
-			match t with
-			| TAbstractDecl ({a_impl = Some c} as a) when a.a_enum && not (path_exists cctx a.a_path) && ctx.c.curclass != c ->
-				add_path cctx a.a_path;
+		Timer.time ctx.com.timer_ctx ["display";"toplevel collect";"fields"] (fun () ->
+			(* member fields *)
+			if ctx.e.curfun <> FunStatic then begin
+				let all_fields = Type.TClass.get_all_fields ctx.c.curclass (extract_param_types ctx.c.curclass.cl_params) in
+				PMap.iter (fun _ (c,cf) ->
+					let origin = if c == ctx.c.curclass then Self (TClassDecl c) else Parent (TClassDecl c) in
+					maybe_add_field CFSMember origin cf
+				) all_fields;
+				(* TODO: local using? *)
+			end;
+
+			(* statics *)
+			begin match ctx.c.curclass.cl_kind with
+			| KAbstractImpl ({a_impl = Some c} as a) ->
+				let origin = Self (TAbstractDecl a) in
 				List.iter (fun cf ->
-					let ccf = CompletionClassField.make cf CFSMember (Self (decl_of_class c)) true in
-					if (has_class_field_flag cf CfEnum) && not (Meta.has Meta.NoCompletion cf.cf_meta) then
-						add (make_ci_enum_abstract_field a ccf (tpair cf.cf_type)) (Some cf.cf_name);
+					if has_class_field_flag cf CfImpl then begin
+						if ctx.e.curfun = FunStatic then ()
+						else begin
+							let cf = prepare_using_field cf in
+							maybe_add_field CFSMember origin cf
+						end
+					end else
+						maybe_add_field CFSStatic origin cf
 				) c.cl_ordered_statics
-			| TTypeDecl t ->
-				begin match follow t.t_type with
-					| TEnum (e,_) -> enum_ctors (TEnumDecl e)
-					| _ -> ()
-				end
-			| TEnumDecl e when not (path_exists cctx e.e_path) ->
-				add_path cctx e.e_path;
-				let origin = Self (TEnumDecl e) in
-				PMap.iter (fun _ ef ->
-					let is_qualified = is_qualified cctx ef.ef_name in
-					add (make_ci_enum_field (CompletionEnumField.make ef origin is_qualified) (tpair ef.ef_type)) (Some ef.ef_name)
-				) e.e_constrs;
 			| _ ->
-				()
-		in
-		List.iter enum_ctors ctx.m.curmod.m_types;
-		List.iter enum_ctors (List.map fst ctx.m.import_resolution#extract_type_imports);
-
-		(* enum constructors of expected type *)
-		begin match with_type with
-			| WithType.WithType(t,_) ->
-				(try enum_ctors (module_type_of_type (follow t)) with Exit -> ())
-			| _ -> ()
-		end;
-		t();
-
-		let t = Timer.timer ["display";"toplevel collect";"globals"] in
-		(* imported globals *)
-		PMap.iter (fun name (mt,s,_) ->
-			try
-				let is_qualified = is_qualified cctx name in
-				let class_import c =
-					let cf = PMap.find s c.cl_statics in
-					let cf = if name = cf.cf_name then cf else {cf with cf_name = name} in
-					let decl,make = match c.cl_kind with
-						| KAbstractImpl a -> TAbstractDecl a,
-							if has_class_field_flag cf CfEnum then make_ci_enum_abstract_field a else make_ci_class_field
-						| _ -> TClassDecl c,make_ci_class_field
+				List.iter (maybe_add_field CFSStatic (Self (TClassDecl ctx.c.curclass))) ctx.c.curclass.cl_ordered_statics
+			end;
+		) ();
+
+		Timer.time ctx.com.timer_ctx ["display";"toplevel collect";"enum ctors"] (fun () ->
+			(* enum constructors *)
+			let rec enum_ctors t =
+				match t with
+				| TAbstractDecl ({a_impl = Some c} as a) when a.a_enum && not (path_exists cctx a.a_path) && ctx.c.curclass != c ->
+					add_path cctx a.a_path;
+					List.iter (fun cf ->
+						let ccf = CompletionClassField.make cf CFSMember (Self (decl_of_class c)) true in
+						if (has_class_field_flag cf CfEnum) && not (Meta.has Meta.NoCompletion cf.cf_meta) then
+							add (make_ci_enum_abstract_field a ccf (tpair cf.cf_type)) (Some cf.cf_name);
+					) c.cl_ordered_statics
+				| TTypeDecl t ->
+					begin match follow t.t_type with
+						| TEnum (e,_) -> enum_ctors (TEnumDecl e)
+						| _ -> ()
+					end
+				| TEnumDecl e when not (path_exists cctx e.e_path) ->
+					add_path cctx e.e_path;
+					let origin = Self (TEnumDecl e) in
+					PMap.iter (fun _ ef ->
+						let is_qualified = is_qualified cctx ef.ef_name in
+						add (make_ci_enum_field (CompletionEnumField.make ef origin is_qualified) (tpair ef.ef_type)) (Some ef.ef_name)
+					) e.e_constrs;
+				| _ ->
+					()
+			in
+			List.iter enum_ctors ctx.m.curmod.m_types;
+			List.iter enum_ctors (List.map fst ctx.m.import_resolution#extract_type_imports);
+
+			(* enum constructors of expected type *)
+			begin match with_type with
+				| WithType.WithType(t,_) ->
+					(try enum_ctors (module_type_of_type (follow t)) with Exit -> ())
+				| _ -> ()
+			end;
+		) ();
+
+		Timer.time ctx.com.timer_ctx ["display";"toplevel collect";"globals"] (fun () ->
+			(* imported globals *)
+			PMap.iter (fun name (mt,s,_) ->
+				try
+					let is_qualified = is_qualified cctx name in
+					let class_import c =
+						let cf = PMap.find s c.cl_statics in
+						let cf = if name = cf.cf_name then cf else {cf with cf_name = name} in
+						let decl,make = match c.cl_kind with
+							| KAbstractImpl a -> TAbstractDecl a,
+								if has_class_field_flag cf CfEnum then make_ci_enum_abstract_field a else make_ci_class_field
+							| _ -> TClassDecl c,make_ci_class_field
+						in
+						let origin = StaticImport decl in
+						if can_access ctx c cf true && not (Meta.has Meta.NoCompletion cf.cf_meta) then begin
+							add (make (CompletionClassField.make cf CFSStatic origin is_qualified) (tpair ~values:(get_value_meta cf.cf_meta) cf.cf_type)) (Some name)
+						end
 					in
-					let origin = StaticImport decl in
-					if can_access ctx c cf true && not (Meta.has Meta.NoCompletion cf.cf_meta) then begin
-						add (make (CompletionClassField.make cf CFSStatic origin is_qualified) (tpair ~values:(get_value_meta cf.cf_meta) cf.cf_type)) (Some name)
+					match resolve_typedef mt with
+						| TClassDecl c -> class_import c;
+						| TEnumDecl en ->
+							let ef = PMap.find s en.e_constrs in
+							let ef = if name = ef.ef_name then ef else {ef with ef_name = name} in
+							let origin = StaticImport (TEnumDecl en) in
+							add (make_ci_enum_field (CompletionEnumField.make ef origin is_qualified) (tpair ef.ef_type)) (Some s)
+						| TAbstractDecl {a_impl = Some c} -> class_import c;
+						| _ -> raise Not_found
+				with Not_found ->
+					()
+			) ctx.m.import_resolution#extract_field_imports;
+		) ();
+
+		Timer.time ctx.com.timer_ctx ["display";"toplevel collect";"rest"] (fun () ->
+			(* literals *)
+			add (make_ci_literal "null" (tpair t_dynamic)) (Some "null");
+			add (make_ci_literal "true" (tpair ctx.com.basic.tbool)) (Some "true");
+			add (make_ci_literal "false" (tpair ctx.com.basic.tbool)) (Some "false");
+			begin match ctx.e.curfun with
+				| FunMember | FunConstructor | FunMemberClassLocal ->
+					let t = TInst(ctx.c.curclass,extract_param_types ctx.c.curclass.cl_params) in
+					add (make_ci_literal "this" (tpair t)) (Some "this");
+					begin match ctx.c.curclass.cl_super with
+						| Some(c,tl) -> add (make_ci_literal "super" (tpair (TInst(c,tl)))) (Some "super")
+						| None -> ()
 					end
-				in
-				match resolve_typedef mt with
-					| TClassDecl c -> class_import c;
-					| TEnumDecl en ->
-						let ef = PMap.find s en.e_constrs in
-						let ef = if name = ef.ef_name then ef else {ef with ef_name = name} in
-						let origin = StaticImport (TEnumDecl en) in
-						add (make_ci_enum_field (CompletionEnumField.make ef origin is_qualified) (tpair ef.ef_type)) (Some s)
-					| TAbstractDecl {a_impl = Some c} -> class_import c;
-					| _ -> raise Not_found
-			with Not_found ->
-				()
-		) ctx.m.import_resolution#extract_field_imports;
-		t();
-
-		let t = Timer.timer ["display";"toplevel collect";"rest"] in
-		(* literals *)
-		add (make_ci_literal "null" (tpair t_dynamic)) (Some "null");
-		add (make_ci_literal "true" (tpair ctx.com.basic.tbool)) (Some "true");
-		add (make_ci_literal "false" (tpair ctx.com.basic.tbool)) (Some "false");
-		begin match ctx.e.curfun with
-			| FunMember | FunConstructor | FunMemberClassLocal ->
-				let t = TInst(ctx.c.curclass,extract_param_types ctx.c.curclass.cl_params) in
-				add (make_ci_literal "this" (tpair t)) (Some "this");
-				begin match ctx.c.curclass.cl_super with
-					| Some(c,tl) -> add (make_ci_literal "super" (tpair (TInst(c,tl)))) (Some "super")
-					| None -> ()
-				end
-			| FunMemberAbstract ->
-				let t = TInst(ctx.c.curclass,extract_param_types ctx.c.curclass.cl_params) in
-				add (make_ci_literal "abstract" (tpair t)) (Some "abstract");
-			| _ ->
-				()
-		end;
-
-		if not is_legacy_completion then begin
-			(* keywords *)
-			let kwds = [
-				Function; Var; Final; If; Else; While; Do; For; Break; Return; Continue; Switch;
-				Try; New; Throw; Untyped; Cast; Inline;
-			] in
-			List.iter (fun kwd -> add(make_ci_keyword kwd) (Some (s_keyword kwd))) kwds;
-
-			(* builtins *)
-			add (make_ci_literal "trace" (tpair (TFun(["value",false,t_dynamic],ctx.com.basic.tvoid)))) (Some "trace")
-		end;
-		t()
+				| FunMemberAbstract ->
+					let t = TInst(ctx.c.curclass,extract_param_types ctx.c.curclass.cl_params) in
+					add (make_ci_literal "abstract" (tpair t)) (Some "abstract");
+				| _ ->
+					()
+			end;
+
+			if not is_legacy_completion then begin
+				(* keywords *)
+				let kwds = [
+					Function; Var; Final; If; Else; While; Do; For; Break; Return; Continue; Switch;
+					Try; New; Throw; Untyped; Cast; Inline;
+				] in
+				List.iter (fun kwd -> add(make_ci_keyword kwd) (Some (s_keyword kwd))) kwds;
+
+				(* builtins *)
+				add (make_ci_literal "trace" (tpair (TFun(["value",false,t_dynamic],ctx.com.basic.tvoid)))) (Some "trace")
+			end;
+		) ();
 	end;
 
 	(* type params *)
@@ -473,75 +472,76 @@ let collect ctx tk with_type sort =
 	(* module imports *)
 	List.iter add_type (List.rev_map fst ctx.m.import_resolution#extract_type_imports); (* reverse! *)
 
-	let t_syntax = Timer.timer ["display";"toplevel collect";"syntax"] in
-	(* types from files *)
 	let cs = ctx.com.cs in
-	(* online: iter context files *)
-	init_or_update_server cs ctx.com ["display";"toplevel"];
-	let cc = CommonCache.get_cache ctx.com in
-	let files = cc#get_files in
-	(* Sort files by reverse distance of their package to our current package. *)
-	let files = Hashtbl.fold (fun file cfile acc ->
-		let i = pack_similarity curpack cfile.c_package in
-		((file,cfile),i) :: acc
-	) files [] in
-	let files = List.sort (fun (_,i1) (_,i2) -> -compare i1 i2) files in
-	let check_package pack = match List.rev pack with
+		let check_package pack = match List.rev pack with
 		| [] -> ()
 		| s :: sl -> add_package (List.rev sl,s)
 	in
-	List.iter (fun ((file_key,cfile),_) ->
-		let module_name = CompilationCache.get_module_name_of_cfile cfile.c_file_path.file cfile in
-		let dot_path = s_type_path (cfile.c_package,module_name) in
-		(* In legacy mode we only show toplevel types. *)
-		if is_legacy_completion && cfile.c_package <> [] then begin
-			(* And only toplevel packages. *)
-			match cfile.c_package with
-			| [s] -> add_package ([],s)
-			| _ -> ()
-		end else if (List.exists (fun e -> ExtString.String.starts_with dot_path (e ^ ".")) !exclude) then
-			()
-		else begin
-			ctx.com.module_to_file#add (cfile.c_package,module_name) cfile.c_file_path;
-			if process_decls cfile.c_package module_name cfile.c_decls then check_package cfile.c_package;
-		end
-	) files;
-	t_syntax();
-
-	let t_native_lib = Timer.timer ["display";"toplevel collect";"native lib"] in
-	List.iter (fun file ->
-		match cs#get_native_lib file with
-		| Some lib ->
-			Hashtbl.iter (fun path (pack,decls) ->
-				if process_decls pack (snd path) decls then check_package pack;
-			) lib.c_nl_files
-		| None ->
-			()
-	) ctx.com.native_libs.all_libs;
-	t_native_lib();
-
-	let t_packages = Timer.timer ["display";"toplevel collect";"packages"] in
-	(* packages *)
-	Hashtbl.iter (fun path _ ->
-		let full_pack = fst path @ [snd path] in
-		if is_pack_visible full_pack then add (make_ci_package path []) (Some (snd path))
-	) packages;
-	t_packages();
-
-	t();
-
-	let t = Timer.timer ["display";"toplevel sorting"] in
-	(* sorting *)
-	let l = DynArray.to_list cctx.items in
-	let l = if is_legacy_completion then
-		List.sort (fun item1 item2 -> compare (get_name item1) (get_name item2)) l
-	else if sort then
-		Display.sort_fields l with_type tk
-	else
+	Timer.time ctx.com.timer_ctx ["display";"toplevel collect";"syntax"] (fun () ->
+		(* types from files *)
+		(* online: iter context files *)
+		init_or_update_server cs ctx.com ["display";"toplevel"];
+		let cc = CommonCache.get_cache ctx.com in
+		let files = cc#get_files in
+		(* Sort files by reverse distance of their package to our current package. *)
+		let files = Hashtbl.fold (fun file cfile acc ->
+			let i = pack_similarity curpack cfile.c_package in
+			((file,cfile),i) :: acc
+		) files [] in
+		let files = List.sort (fun (_,i1) (_,i2) -> -compare i1 i2) files in
+		List.iter (fun ((file_key,cfile),_) ->
+			let module_name = CompilationCache.get_module_name_of_cfile cfile.c_file_path.file cfile in
+			let dot_path = s_type_path (cfile.c_package,module_name) in
+			(* In legacy mode we only show toplevel types. *)
+			if is_legacy_completion && cfile.c_package <> [] then begin
+				(* And only toplevel packages. *)
+				match cfile.c_package with
+				| [s] -> add_package ([],s)
+				| _ -> ()
+			end else if (List.exists (fun e -> ExtString.String.starts_with dot_path (e ^ ".")) !exclude) then
+				()
+			else begin
+				ctx.com.module_to_file#add (cfile.c_package,module_name) cfile.c_file_path;
+				if process_decls cfile.c_package module_name cfile.c_decls then check_package cfile.c_package;
+			end
+		) files;
+	) ();
+
+	Timer.time ctx.com.timer_ctx ["display";"toplevel collect";"native lib"] (fun () ->
+		List.iter (fun file ->
+			match cs#get_native_lib file with
+			| Some lib ->
+				Hashtbl.iter (fun path (pack,decls) ->
+					if process_decls pack (snd path) decls then check_package pack;
+				) lib.c_nl_files
+			| None ->
+				()
+		) ctx.com.native_libs.all_libs;
+	) ();
+
+	Timer.time ctx.com.timer_ctx ["display";"toplevel collect";"packages"] (fun () ->
+		(* packages *)
+		Hashtbl.iter (fun path _ ->
+			let full_pack = fst path @ [snd path] in
+			if is_pack_visible full_pack then add (make_ci_package path []) (Some (snd path))
+		) packages;
+	) ();
+
+	Timer.time ctx.com.timer_ctx ["display";"toplevel sorting"] (fun () ->
+		(* sorting *)
+		let l = DynArray.to_list cctx.items in
+		let l = if is_legacy_completion then
+			List.sort (fun item1 item2 -> compare (get_name item1) (get_name item2)) l
+		else if sort then
+			Display.sort_fields l with_type tk
+		else
+			l
+		in
 		l
-	in
-	t();
-	l
+	) ()
+
+let collect ctx tk with_type sort =
+	Timer.time ctx.com.timer_ctx ["display";"toplevel collect"] (collect ctx tk with_type) sort
 
 let collect_and_raise ctx tk with_type cr (name,pname) pinsert =
 	let fields = match !DisplayException.last_completion_pos with

+ 4 - 4
src/context/display/exprPreprocessing.ml

@@ -3,7 +3,7 @@ open Ast
 open DisplayTypes.DisplayMode
 open DisplayPosition
 
-let find_before_pos dm e =
+let find_before_pos was_auto_triggered dm e =
 	let display_pos = ref (DisplayPosition.display_position#get) in
 	let was_annotated = ref false in
 	let is_annotated,is_completion = match dm with
@@ -160,7 +160,7 @@ let find_before_pos dm e =
 			raise Exit
 		| EMeta((Meta.Markup,_,_),(EConst(String _),p)) when is_annotated p ->
 			annotate_marked e
-		| EConst (String (_,q)) when ((q <> SSingleQuotes) || !Parser.was_auto_triggered) && is_annotated (pos e) && is_completion ->
+		| EConst (String (_,q)) when ((q <> SSingleQuotes) || was_auto_triggered) && is_annotated (pos e) && is_completion ->
 			(* TODO: check if this makes any sense *)
 			raise Exit
 		| EConst(Regexp _) when is_annotated (pos e) && is_completion ->
@@ -199,13 +199,13 @@ let find_before_pos dm e =
 	in
 	try map e with Exit -> e
 
-let find_display_call e =
+let find_display_call was_auto_triggered e =
 	let found = ref false in
 	let handle_el e el =
 		let call_arg_is_marked () =
 			el = [] || List.exists (fun (e,_) -> match e with EDisplay(_,DKMarked) -> true | _ -> false) el
 		in
-		if not !Parser.was_auto_triggered || call_arg_is_marked () then begin
+		if not was_auto_triggered || call_arg_is_marked () then begin
 		found := true;
 		Parser.mk_display_expr e DKCall
 		end else

+ 25 - 29
src/context/display/findReferences.ml

@@ -8,22 +8,20 @@ let find_possible_references tctx cs =
 	let name,_,kind = Display.ReferencePosition.get () in
 	ignore(SyntaxExplorer.explore_uncached_modules tctx cs [name,kind])
 
-let find_references tctx com with_definition pos_filters =
-	let t = Timer.timer ["display";"references";"collect"] in
-	let symbols,relations = Statistics.collect_statistics tctx pos_filters true in
-	t();
+let find_references com with_definition pos_filters =
+	let symbols,relations = Timer.time com.timer_ctx ["display";"references";"collect"] (Statistics.collect_statistics com pos_filters) true in
 	let rec loop acc (relations:(Statistics.relation * pos) list) = match relations with
 		| (Statistics.Referenced,p) :: relations when not (List.mem p acc) -> loop (p :: acc) relations
 		| _ :: relations -> loop acc relations
 		| [] -> acc
 	in
-	let t = Timer.timer ["display";"references";"filter"] in
-	let usages = Hashtbl.fold (fun p sym acc ->
-		let acc = if with_definition then p :: acc else acc in
-		(try loop acc (Hashtbl.find relations p)
-		with Not_found -> acc)
-	) symbols [] in
-	t();
+	let usages = Timer.time com.timer_ctx ["display";"references";"filter"] (fun () ->
+		Hashtbl.fold (fun p sym acc ->
+			let acc = if with_definition then p :: acc else acc in
+			(try loop acc (Hashtbl.find relations p)
+			with Not_found -> acc)
+		) symbols []
+	) () in
 	Display.ReferencePosition.reset();
 	usages
 
@@ -121,14 +119,14 @@ let rec collect_reference_positions com (name,pos,kind) =
 	| _ ->
 		[name,pos,kind]
 
-let find_references tctx com with_definition =
+let find_references com with_definition =
 	let pos_filters =
 		List.fold_left (fun acc (_,p,_) ->
 			if p = null_pos then acc
 			else Statistics.SFPos p :: acc
 		) [] (collect_reference_positions com (Display.ReferencePosition.get ()))
 	in
-	let usages = find_references tctx com with_definition pos_filters in
+	let usages = find_references com with_definition pos_filters in
 	let usages =
 		List.sort (fun p1 p2 ->
 			let c = compare p1.pfile p2.pfile in
@@ -137,29 +135,27 @@ let find_references tctx com with_definition =
 	in
 	DisplayException.raise_positions usages
 
-let find_implementations tctx com name pos kind =
-	let t = Timer.timer ["display";"implementations";"collect"] in
-	let symbols,relations = Statistics.collect_statistics tctx [SFPos pos] false in
-	t();
+let find_implementations com name pos kind =
+	let symbols,relations = Timer.time com.timer_ctx ["display";"implementations";"collect"] (Statistics.collect_statistics com [SFPos pos]) false in
 	let rec loop acc relations = match relations with
 		| ((Statistics.Implemented | Statistics.Overridden | Statistics.Extended),p) :: relations -> loop (p :: acc) relations
 		| _ :: relations -> loop acc relations
 		| [] -> acc
 	in
-	let t = Timer.timer ["display";"implementations";"filter"] in
-	let usages = Hashtbl.fold (fun p sym acc ->
-		(try loop acc (Hashtbl.find relations p)
-		with Not_found -> acc)
-	) symbols [] in
-	let usages = List.sort (fun p1 p2 ->
-		let c = compare p1.pfile p2.pfile in
-		if c <> 0 then c else compare p1.pmin p2.pmin
-	) usages in
-	t();
+	let usages = Timer.time com.timer_ctx ["display";"implementations";"filter"] (fun () ->
+		let usages = Hashtbl.fold (fun p sym acc ->
+			(try loop acc (Hashtbl.find relations p)
+			with Not_found -> acc)
+		) symbols [] in
+		List.sort (fun p1 p2 ->
+			let c = compare p1.pfile p2.pfile in
+			if c <> 0 then c else compare p1.pmin p2.pmin
+		) usages
+	) () in
 	Display.ReferencePosition.reset();
 	DisplayException.raise_positions usages
 
-let find_implementations tctx com =
+let find_implementations com =
 	let name,pos,kind = Display.ReferencePosition.get () in
-	if pos <> null_pos then find_implementations tctx com name pos kind
+	if pos <> null_pos then find_implementations com name pos kind
 	else DisplayException.raise_positions []

+ 4 - 4
src/context/display/statistics.ml

@@ -15,7 +15,7 @@ type statistics_filter =
 	| SFPos of pos
 	| SFFile of string
 
-let collect_statistics ctx pos_filters with_expressions =
+let collect_statistics com pos_filters with_expressions =
 	let relations = Hashtbl.create 0 in
 	let symbols = Hashtbl.create 0 in
 	let handled_modules = Hashtbl.create 0 in
@@ -25,7 +25,7 @@ let collect_statistics ctx pos_filters with_expressions =
 			try
 				Hashtbl.find paths path
 			with Not_found ->
-				let unique = ctx.com.file_keys#get path in
+				let unique = com.file_keys#get path in
 				Hashtbl.add paths path unique;
 				unique
 		)
@@ -209,7 +209,7 @@ let collect_statistics ctx pos_filters with_expressions =
 		List.iter f com.types;
 		Option.may loop (com.get_macros())
 	in
-	loop ctx.com;
+	loop com;
 	(* find things *)
 	let f = function
 		| TClassDecl c ->
@@ -254,7 +254,7 @@ let collect_statistics ctx pos_filters with_expressions =
 		List.iter f com.types;
 		Option.may loop (com.get_macros())
 	in
-	loop ctx.com;
+	loop com;
 	(* TODO: Using syntax-exploration here is technically fine, but I worry about performance in real codebases. *)
 	(* let find_symbols = Hashtbl.fold (fun _ kind acc ->
 		let name = string_of_symbol kind in

+ 18 - 18
src/context/display/syntaxExplorer.ml

@@ -165,23 +165,23 @@ let explore_uncached_modules tctx cs symbols =
 	let cc = CommonCache.get_cache tctx.com in
 	let files = cc#get_files in
 	let modules = cc#get_modules in
-	let t = Timer.timer ["display";"references";"candidates"] in
-	let acc = Hashtbl.fold (fun file_key cfile acc ->
-		let module_name = get_module_name_of_cfile cfile.c_file_path.file cfile in
-		if Hashtbl.mem modules (cfile.c_package,module_name) then
-			acc
-		else try
-			find_in_syntax symbols (cfile.c_package,cfile.c_decls);
-			acc
-		with Exit ->
-			begin try
-				let m = tctx.g.do_load_module tctx (cfile.c_package,module_name) null_pos in
-				(* We have to flush immediately so we catch exceptions from weird modules *)
-				Typecore.flush_pass tctx.g PFinal ("final",cfile.c_package @ [module_name]);
-				m :: acc
-			with _ ->
+	let acc = Timer.time tctx.com.timer_ctx ["display";"references";"candidates"] (fun () ->
+		Hashtbl.fold (fun file_key cfile acc ->
+			let module_name = get_module_name_of_cfile cfile.c_file_path.file cfile in
+			if Hashtbl.mem modules (cfile.c_package,module_name) then
 				acc
-			end
-	) files [] in
-	t();
+			else try
+				find_in_syntax symbols (cfile.c_package,cfile.c_decls);
+				acc
+			with Exit ->
+				begin try
+					let m = tctx.g.do_load_module tctx (cfile.c_package,module_name) null_pos in
+					(* We have to flush immediately so we catch exceptions from weird modules *)
+					Typecore.flush_pass tctx.g PFinal ("final",cfile.c_package @ [module_name]);
+					m :: acc
+				with _ ->
+					acc
+				end
+		) files []
+	) () in
 	acc

+ 3 - 3
src/context/formatString.ml

@@ -1,7 +1,7 @@
 open Globals
 open Ast
 
-let format_string defines s p process_expr =
+let format_string config s p process_expr =
 	let e = ref None in
 	let pmin = ref p.pmin in
 	let min = ref (p.pmin + 1) in
@@ -83,8 +83,8 @@ let format_string defines s p process_expr =
 					if Lexer.string_is_whitespace scode then Error.raise_typing_error "Expression cannot be empty" ep
 					else Error.raise_typing_error msg pos
 				in
-				match ParserEntry.parse_expr_string defines scode ep error true with
-					| ParseSuccess(data,_,_) -> data
+				match ParserEntry.parse_expr_string config scode ep error true with
+					| ParseSuccess(data,_) -> data
 					| ParseError(_,(msg,p),_) -> error (Parser.error_msg msg) p
 			in
 			add_expr e slen

+ 0 - 50
src/context/lookup.ml

@@ -7,21 +7,13 @@ class virtual ['key,'value] lookup = object(self)
 	method virtual fold : 'acc . ('key -> 'value -> 'acc -> 'acc) -> 'acc -> 'acc
 	method virtual mem : 'key -> bool
 	method virtual clear : unit
-
-	method virtual start_group : int
-	method virtual commit_group : int -> int
-	method virtual discard_group : int -> int
 end
 
 class ['key,'value] pmap_lookup = object(self)
 	inherit ['key,'value] lookup
 	val mutable lut : ('key,'value) PMap.t = PMap.empty
 
-	val mutable group_id : int ref = ref 0
-	val mutable groups : (int,'key list) PMap.t = PMap.empty
-
 	method add (key : 'key) (value : 'value) =
-		groups <- PMap.map (fun modules -> key :: modules) groups;
 		lut <- PMap.add key value lut
 
 	method remove (key : 'key) =
@@ -41,36 +33,13 @@ class ['key,'value] pmap_lookup = object(self)
 
 	method clear =
 		lut <- PMap.empty
-
-	method start_group =
-		incr group_id;
-		let i = !group_id in
-		groups <- PMap.add i [] groups;
-		i
-
-	method commit_group i =
-		let group = PMap.find i groups in
-		let n = List.length group in
-		groups <- PMap.remove i groups;
-		n
-
-	method discard_group i =
-		let group = PMap.find i groups in
-		let n = List.length group in
-		List.iter (fun mpath -> self#remove mpath) group;
-		groups <- PMap.remove i groups;
-		n
 end
 
 class ['key,'value] hashtbl_lookup = object(self)
 	inherit ['key,'value] lookup
 	val lut : ('key,'value) Hashtbl.t = Hashtbl.create 0
 
-	val mutable group_id : int ref = ref 0
-	val mutable groups : (int,'key list) Hashtbl.t = Hashtbl.create 0
-
 	method add (key : 'key) (value : 'value) =
-		Hashtbl.iter (fun i modules -> Hashtbl.replace groups i (key :: modules)) groups;
 		Hashtbl.replace lut key value
 
 	method remove (key : 'key) =
@@ -90,24 +59,5 @@ class ['key,'value] hashtbl_lookup = object(self)
 
 	method clear =
 		Hashtbl.clear lut
-
-	method start_group =
-		incr group_id;
-		let i = !group_id in
-		Hashtbl.replace groups i [];
-		i
-
-	method commit_group i =
-		let group = Hashtbl.find groups i in
-		let n = List.length group in
-		Hashtbl.remove groups i;
-		n
-
-	method discard_group i =
-		let group = Hashtbl.find groups i in
-		let n = List.length group in
-		List.iter (fun mpath -> self#remove mpath) group;
-		Hashtbl.remove groups i;
-		n
 end
 

+ 28 - 0
src/context/parallel.ml

@@ -0,0 +1,28 @@
+let run_parallel_for num_domains ?(chunk_size=0) length f =
+	let pool = Domainslib.Task.setup_pool ~num_domains:(num_domains - 1) () in
+	Domainslib.Task.run pool (fun _ -> Domainslib.Task.parallel_for pool ~chunk_size ~start:0 ~finish:(length-1) ~body:f);
+	Domainslib.Task.teardown_pool pool
+
+module ParallelArray = struct
+	let iter pool f a =
+		let f' idx = f a.(idx) in
+		Domainslib.Task.parallel_for pool ~start:0 ~finish:(Array.length a - 1) ~body:f'
+
+	let map pool f a x =
+		let length = Array.length a in
+		let a_out = Array.make length x in
+		let f' idx =
+			Array.unsafe_set a_out idx (f (Array.unsafe_get a idx))
+		in
+		Domainslib.Task.parallel_for pool ~start:0 ~finish:(length - 1) ~body:f';
+		a_out
+end
+
+module ParallelSeq = struct
+	let iter pool f seq =
+		ParallelArray.iter pool f (Array.of_seq seq)
+end
+
+let run_in_new_pool timer_ctx f =
+	let pool = Timer.time timer_ctx ["domainslib";"setup"] (Domainslib.Task.setup_pool ~num_domains:(Domain.recommended_domain_count() - 1)) () in
+	Std.finally (fun () -> Timer.time timer_ctx ["domainslib";"teardown"] Domainslib.Task.teardown_pool pool) (Domainslib.Task.run pool) (fun () -> f pool)

+ 123 - 0
src/context/platformConfig.ml

@@ -0,0 +1,123 @@
+open Globals
+open Type
+
+(**
+	The capture policy tells which handling we make of captured locals
+	(the locals which are referenced in local functions)
+
+	See details/implementation in Codegen.captured_vars
+*)
+type capture_policy =
+	(** do nothing, let the platform handle it *)
+	| CPNone
+	(** wrap all captured variables into a single-element array to allow modifications *)
+	| CPWrapRef
+	(** similar to wrap ref, but will only apply to the locals that are declared in loops *)
+	| CPLoopVars
+
+type exceptions_config = {
+	(* Base types which may be thrown from Haxe code without wrapping. *)
+	ec_native_throws : path list;
+	(* Base types which may be caught from Haxe code without wrapping. *)
+	ec_native_catches : path list;
+	(*
+		Hint exceptions filter to avoid wrapping for targets, which can throw/catch any type
+		Ignored on targets with a specific native base type for exceptions.
+	*)
+	ec_avoid_wrapping : bool;
+	(* Path of a native class or interface, which can be used for wildcard catches. *)
+	ec_wildcard_catch : path;
+	(*
+		Path of a native base class or interface, which can be thrown.
+		This type is used to cast `haxe.Exception.thrown(v)` calls to.
+		For example `throw 123` is compiled to `throw (cast Exception.thrown(123):ec_base_throw)`
+	*)
+	ec_base_throw : path;
+	(*
+		Checks if throwing this expression is a special case for current target
+		and should not be modified.
+	*)
+	ec_special_throw : texpr -> bool;
+}
+
+type var_scope =
+	| FunctionScope
+	| BlockScope
+
+type var_scoping_flags =
+	(**
+		Variables are hoisted in their scope
+	*)
+	| VarHoisting
+	(**
+		It's not allowed to shadow existing variables in a scope.
+	*)
+	| NoShadowing
+	(**
+		It's not allowed to shadow a `catch` variable.
+	*)
+	| NoCatchVarShadowing
+	(**
+		Local vars cannot have the same name as the current top-level package or
+		(if in the root package) current class name
+	*)
+	| ReserveCurrentTopLevelSymbol
+	(**
+		Local vars cannot have a name used for any top-level symbol
+		(packages and classes in the root package)
+	*)
+	| ReserveAllTopLevelSymbols
+	(**
+		Reserve all type-paths converted to "flat path" with `Path.flat_path`
+	*)
+	| ReserveAllTypesFlat
+	(**
+		List of names cannot be taken by local vars
+	*)
+	| ReserveNames of string list
+	(**
+		Cases in a `switch` won't have blocks, but will share the same outer scope.
+	*)
+	| SwitchCasesNoBlocks
+
+type var_scoping_config = {
+	vs_flags : var_scoping_flags list;
+	vs_scope : var_scope;
+}
+
+type platform_config = {
+	(** has a static type system, with not-nullable basic types (Int/Float/Bool) *)
+	pf_static : bool;
+	(** has access to the "sys" package *)
+	pf_sys : bool;
+	(** captured variables handling (see before) *)
+	pf_capture_policy : capture_policy;
+	(** when calling a method with optional args, do we replace the missing args with "null" constants *)
+	pf_pad_nulls : bool;
+	(** add a final return to methods not having one already - prevent some compiler warnings *)
+	pf_add_final_return : bool;
+	(** does the platform natively support overloaded functions *)
+	pf_overload : bool;
+	(** can the platform use default values for non-nullable arguments *)
+	pf_can_skip_non_nullable_argument : bool;
+	(** type paths that are reserved on the platform *)
+	pf_reserved_type_paths : path list;
+	(** supports function == function **)
+	pf_supports_function_equality : bool;
+	(** uses utf16 encoding with ucs2 api **)
+	pf_uses_utf16 : bool;
+	(** target supports accessing `this` before calling `super(...)` **)
+	pf_this_before_super : bool;
+	(** target supports threads **)
+	pf_supports_threads : bool;
+	(** target supports Unicode **)
+	pf_supports_unicode : bool;
+	(** target supports rest arguments **)
+	pf_supports_rest_args : bool;
+	(** exceptions handling config **)
+	pf_exceptions : exceptions_config;
+	(** the scoping of local variables *)
+	pf_scoping : var_scoping_config;
+	(** target supports atomic operations via haxe.Atomic **)
+	pf_supports_atomics : bool;
+}

+ 11 - 0
src/context/resolution.ml

@@ -180,6 +180,17 @@ class resolution_list (id : string list) = object(self)
 	method get_list =
 		l
 
+	method set_list l' =
+		l <- l';
+		cached_type_imports <- false
+
+	method clone_as (id : string list) =
+		self#resolve_lazies;
+		let rl = new resolution_list id in
+		rl#set_list l;
+		rl#cache_type_imports;
+		rl
+
 	method cache_type_imports =
 		let rec loop = function
 		| [] ->

+ 166 - 0
src/context/safeCom.ml

@@ -0,0 +1,166 @@
+open Globals
+open Type
+open PlatformConfig
+
+type saved_warning = {
+	w_module : module_def;
+	w_warning : WarningList.warning;
+	w_options : Warning.warning_option list list;
+	w_msg : string;
+	w_pos : pos;
+}
+
+type t = {
+	basic : basic_types;
+	platform : platform;
+	defines : Define.define;
+	platform_config : platform_config;
+	debug : bool;
+	is_macro_context : bool;
+	foptimize : bool;
+	doinline : bool;
+	exceptions : exn list ref;
+	exceptions_mutex : Mutex.t;
+	warnings : saved_warning list ref;
+	warnings_mutex : Mutex.t;
+	errors : Error.error list ref;
+	errors_mutex : Mutex.t;
+	timer_ctx : Timer.timer_context;
+	find_module : path -> module_def;
+	find_module_by_type : path -> module_def;
+	curclass : tclass;
+	curfield : tclass_field;
+}
+
+let of_com (com : Common.context) = {
+	basic = com.basic;
+	platform = com.platform;
+	defines = com.defines;
+	platform_config = com.config;
+	debug = com.debug;
+	is_macro_context = com.is_macro_context;
+	foptimize = com.foptimize;
+	doinline = com.doinline;
+	exceptions = ref [];
+	exceptions_mutex = Mutex.create ();
+	warnings = ref [];
+	warnings_mutex = Mutex.create ();
+	errors = ref [];
+	errors_mutex = Mutex.create ();
+	timer_ctx = com.timer_ctx;
+	find_module = com.module_lut#find;
+	find_module_by_type = com.module_lut#find_by_type;
+	curclass = null_class;
+	curfield = null_field;
+}
+
+let of_typer (ctx : Typecore.typer) = {
+	(of_com ctx.com) with
+	curclass = ctx.c.curclass;
+	curfield = ctx.f.curfield;
+}
+
+let finalize scom com =
+	let warnings = !(scom.warnings) in
+	let errors = !(scom.errors) in
+	let exns = !(scom.exceptions) in
+	scom.warnings := [];
+	scom.errors := [];
+	scom.exceptions := [];
+	List.iter (fun warning ->
+		Common.module_warning com warning.w_module warning.w_warning warning.w_options warning.w_msg warning.w_pos
+	) warnings;
+	List.iter (fun err ->
+		Common.display_error_ext com err
+	) errors;
+	match exns with
+	| x :: _ ->
+		raise x
+	| [] ->
+		()
+
+let run_with_scom com scom f =
+	Std.finally (fun() -> finalize scom com) f ()
+
+let add_error scom err =
+	Mutex.protect scom.errors_mutex (fun () -> scom.errors := err :: !(scom.errors))
+
+let add_exn scom exn = match exn with
+	| Error.Error err ->
+		add_error scom err
+	| _ ->
+		Mutex.protect scom.exceptions_mutex (fun () -> scom.exceptions := exn :: !(scom.exceptions))
+
+let add_warning scom w msg p =
+	let options = (Warning.from_meta scom.curfield.cf_meta) @ (Warning.from_meta scom.curclass.cl_meta) in
+	match Warning.get_mode w options with
+	| WMEnable ->
+		Mutex.protect scom.warnings_mutex (fun () ->
+			let warning = {
+				w_module = scom.curclass.cl_module;
+				w_warning = w;
+				w_options = options;
+				w_msg = msg;
+				w_pos = p;
+			} in
+			scom.warnings := warning :: !(scom.warnings)
+		)
+	| WMDisable ->
+		()
+
+let run_expression_filters_safe ?(ignore_processed_status=false) scom detail_times filters t =
+	let run scom identifier e =
+		try
+			List.fold_left (fun e (filter_name,f) ->
+				try
+					FilterContext.with_timer scom.timer_ctx detail_times filter_name identifier (fun () -> f scom e)
+				with Failure msg ->
+					Error.raise_typing_error msg e.epos
+			) e filters
+		with exc ->
+			add_exn scom exc;
+			e
+	in
+	match t with
+	| TClassDecl c when FilterContext.is_removable_class c -> ()
+	| TClassDecl c ->
+		let scom = {scom with curclass = c} in
+		let rec process_field cf =
+			if ignore_processed_status || not (has_class_field_flag cf CfPostProcessed) then begin
+				let scom = {scom with curfield = cf} in
+				(match cf.cf_expr with
+				| Some e when not (FilterContext.is_removable_field scom.is_macro_context cf) ->
+					let identifier = Printf.sprintf "%s.%s" (s_type_path c.cl_path) cf.cf_name in
+					cf.cf_expr <- Some (run scom (Some identifier) e);
+				| _ -> ());
+			end;
+			List.iter process_field cf.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);
+		(match TClass.get_cl_init c with
+		| None -> ()
+		| Some e ->
+			let identifier = Printf.sprintf "%s.__init__" (s_type_path c.cl_path) in
+			TClass.set_cl_init c (run scom (Some identifier) e))
+	| TEnumDecl _ -> ()
+	| TTypeDecl _ -> ()
+	| TAbstractDecl _ -> ()
+
+let adapt_scom_to_mt scom mt = match mt with
+	| TClassDecl c ->
+		{scom with curclass = c}
+	| _ ->
+		scom
+
+let run_type_filters_safe scom filters types =
+	List.iter (fun t ->
+		let scom = adapt_scom_to_mt scom t in
+		List.iter (fun f -> f scom t) filters
+	) types
+
+let needs_inline scom c cf =
+	cf.cf_kind = Method MethInline && (scom.doinline || Typecore.is_forced_inline c cf)

+ 24 - 15
src/context/typecore.ml

@@ -94,11 +94,9 @@ type typer_globals = {
 	mutable delayed : typer_pass_tasks Array.t;
 	mutable delayed_min_index : int;
 	mutable debug_delayed : (typer_pass * ((unit -> unit) * (string * string list) * typer) list) list;
-	doinline : bool;
 	retain_meta : bool;
 	mutable core_api : typer option;
 	mutable macros : ((unit -> unit) * typer) option;
-	mutable std_types : module_def;
 	mutable module_check_policies : (string list * module_check_policy list * bool) list;
 	mutable global_using : (tclass * pos) list;
 	(* Indicates that Typer.create() finished building this instance *)
@@ -408,7 +406,7 @@ let unify_raise_custom uctx t1 t2 p =
 			(* no untyped check *)
 			raise_error_msg (Unify l) p
 
-let unify_raise = unify_raise_custom default_unification_context
+let unify_raise a b = unify_raise_custom (default_unification_context()) a b
 
 let save_locals ctx =
 	let locals = ctx.f.locals in
@@ -439,8 +437,6 @@ let add_local_with_origin ctx origin n t p =
 	Naming.check_local_variable_name ctx.com n origin p;
 	add_local ctx (VUser origin) n t p
 
-let gen_local_prefix = "`"
-
 let gen_local ctx t p =
 	add_local ctx VGenerated gen_local_prefix t p
 
@@ -500,15 +496,6 @@ let make_lazy ctx t_proc f where =
 	delay ctx PForce (fun () -> ignore(lazy_type r));
 	r
 
-let is_removable_field com f =
-	not (has_class_field_flag f CfOverride) && (
-		has_class_field_flag f CfExtern || has_class_field_flag f CfGeneric
-		|| (match f.cf_kind with
-			| Var {v_read = AccRequire (s,_)} -> true
-			| Method MethMacro -> not com.is_macro_context
-			| _ -> false)
-	)
-
 let is_forced_inline c cf =
 	match c with
 	| Some { cl_kind = KAbstractImpl _ } -> true
@@ -517,7 +504,7 @@ let is_forced_inline c cf =
 	| _ -> false
 
 let needs_inline ctx c cf =
-	cf.cf_kind = Method MethInline && ctx.allow_inline && (ctx.g.doinline || is_forced_inline c cf)
+	cf.cf_kind = Method MethInline && ctx.allow_inline && (ctx.com.doinline || is_forced_inline c cf)
 
 (** checks if we can access to a given class field using current context *)
 let can_access ctx c cf stat =
@@ -664,6 +651,28 @@ let safe_mono_close ctx m p =
 let relative_path ctx file =
 	ctx.com.class_paths#relative_path file
 
+let mk_infos_t =
+	let fileName = ("fileName",null_pos,NoQuotes) in
+	let lineNumber = ("lineNumber",null_pos,NoQuotes) in
+	let className = ("className",null_pos,NoQuotes) in
+	let methodName = ("methodName",null_pos,NoQuotes) in
+	(fun ctx p params t ->
+		let file = if ctx.com.is_macro_context then p.pfile else if Common.defined ctx.com Define.AbsolutePath then Path.get_full_path p.pfile else relative_path ctx p.pfile in
+		let line = Lexer.get_error_line p in
+		let class_name = s_type_path ctx.c.curclass.cl_path in
+		let fields =
+			(fileName,Texpr.Builder.make_string ctx.com.basic file p) ::
+			(lineNumber,Texpr.Builder.make_int ctx.com.basic line p) ::
+			(className,Texpr.Builder.make_string ctx.com.basic class_name p) ::
+			if ctx.f.curfield.cf_name = "" then
+				params
+			else
+				(methodName,Texpr.Builder.make_string ctx.com.basic ctx.f.curfield.cf_name p) ::
+				params
+		in
+		mk (TObjectDecl fields) t p
+	)
+
 let mk_infos ctx p params =
 	let file = if ctx.com.is_macro_context then p.pfile else if Common.defined ctx.com Define.AbsolutePath then Path.get_full_path p.pfile else relative_path ctx p.pfile in
 	(EObjectDecl (

+ 9 - 8
src/core/abstract.ml

@@ -63,8 +63,6 @@ let find_to uctx b ab tl =
 				Some(find_field_to uctx a b ab tl)
 		)
 
-let underlying_type_stack = new_rec_stack()
-
 (**
 	Returns type parameters and the list of types, which should be known at compile time
 	to be able to choose multitype specialization.
@@ -98,14 +96,14 @@ let rec find_multitype_params a pl =
 		tl,!definitive_types
 
 and find_multitype_specialization_type a pl =
-	let uctx = default_unification_context in
+	let uctx = default_unification_context () in
 	let m = mk_mono() in
 	let tl,definitive_types = find_multitype_params a pl in
 	ignore(find_to uctx m a tl);
 	if List.exists (fun t -> has_mono t) definitive_types then raise Not_found;
 	follow m
 
-and get_underlying_type ?(return_first=false) a pl =
+and get_underlying_type' stack ?(return_first=false) a pl =
 	let maybe_recurse t =
 		let rec loop t = match t with
 			| TMono r ->
@@ -119,12 +117,12 @@ and get_underlying_type ?(return_first=false) a pl =
 			| TType (t,tl) ->
 				loop (apply_typedef t tl)
 			| TAbstract(a,tl) when not (Meta.has Meta.CoreType a.a_meta) ->
-				if rec_stack_exists (fast_eq t) underlying_type_stack then begin
+				if rec_stack_exists (fast_eq t) stack then begin
 					let pctx = print_context() in
-					let s = String.concat " -> " (List.map (fun t -> s_type pctx t) (List.rev (t :: underlying_type_stack.rec_stack))) in
+					let s = String.concat " -> " (List.map (fun t -> s_type pctx t) (List.rev (t :: stack.rec_stack))) in
 					raise_typing_error ("Abstract chain detected: " ^ s) a.a_pos
 				end;
-				get_underlying_type a tl
+				get_underlying_type' stack a tl
 			| _ ->
 				t
 		in
@@ -132,7 +130,7 @@ and get_underlying_type ?(return_first=false) a pl =
 			Even if only the first underlying type was requested
 			keep traversing to detect mutually recursive abstracts
 		*)
-		let result = rec_stack_loop underlying_type_stack (TAbstract(a,pl)) loop t in
+		let result = rec_stack_loop stack (TAbstract(a,pl)) loop t in
 		if return_first then t
 		else result
 	in
@@ -145,6 +143,9 @@ and get_underlying_type ?(return_first=false) a pl =
 		else
 			maybe_recurse (apply_params a.a_params pl a.a_this)
 
+and get_underlying_type ?(return_first=false) a pl =
+	get_underlying_type' (new_rec_stack()) ~return_first a pl
+
 and follow_with_abstracts t = match follow t with
 	| TAbstract(a,tl) when not (Meta.has Meta.CoreType a.a_meta) ->
 		follow_with_abstracts (get_underlying_type a tl)

+ 9 - 1
src/core/define.ml

@@ -6,6 +6,11 @@ type define = {
 	mutable defines_signature : string option;
 }
 
+let empty_defines () = {
+	defines_signature = None;
+	values = PMap.empty;
+}
+
 type user_define = {
 	doc : string;
 	flags : define_parameter list;
@@ -26,16 +31,18 @@ type define_infos = {
 	d_origin : define_origin;
 	d_links : string list;
 	d_deprecated : string option;
+	d_default : string option;
 }
 
 let infos ?user_defines d =
 	let extract_infos (t, (doc, flags), origin) =
-		let params = ref [] and pfs = ref [] and links = ref [] and deprecated = ref None in
+		let params = ref [] and pfs = ref [] and links = ref [] and deprecated = ref None and default = ref None in
 		List.iter (function
 			| HasParam s -> params := s :: !params
 			| Platforms fl -> pfs := fl @ !pfs
 			| Link url -> links := url :: !links
 			| Deprecated s -> deprecated := Some s
+			| DefaultValue s -> default := Some s
 		) flags;
 		(t, {
 			d_doc = doc;
@@ -44,6 +51,7 @@ let infos ?user_defines d =
 			d_origin = origin;
 			d_links = !links;
 			d_deprecated = !deprecated;
+			d_default = !default;
 		})
 	in
 

+ 29 - 0
src/core/ds/nowOrLater.ml

@@ -0,0 +1,29 @@
+type t = {
+	now : Mutex.t;
+	later: (unit -> unit) Queue.t;
+	later_mutex : Mutex.t;
+}
+
+let create () = {
+	now = Mutex.create ();
+	later = Queue.create ();
+	later_mutex = Mutex.create ();
+}
+
+let try_now nol f =
+	if Mutex.try_lock nol.now then begin
+		f();
+		Mutex.unlock nol.now
+	end else begin
+		Mutex.protect nol.later_mutex (fun () -> Queue.push f nol.later)
+	end
+
+let handle_later nol =
+	let rec loop () = match Queue.take_opt nol.later with
+		| Some f ->
+			f ();
+			loop ()
+		| None ->
+			()
+	in
+	loop ()

+ 1 - 10
src/core/ds/stringPool.ml

@@ -1,13 +1,4 @@
-module StringHashtbl = Hashtbl.Make(struct
-	type t = string
-
-	let equal =
-		String.equal
-
-	let hash s =
-		(* What's the best here? *)
-		Hashtbl.hash s
-end)
+open Globals
 
 type t = {
 	lut : int StringHashtbl.t;

+ 18 - 0
src/core/ds/threadSafeHashtbl.ml

@@ -0,0 +1,18 @@
+type ('a,'b) t = {
+	h : ('a,'b) Hashtbl.t;
+	mutex : Mutex.t
+}
+
+let create size = {
+	h = Hashtbl.create size;
+	mutex = Mutex.create ();
+}
+
+let add h k v =
+	Mutex.protect h.mutex (fun () -> Hashtbl.add h.h k) v
+
+let replace h k v =
+	Mutex.protect h.mutex (fun () -> Hashtbl.replace h.h k) v
+
+let find h k =
+	Mutex.protect h.mutex (fun () -> Hashtbl.find h.h) k

+ 21 - 0
src/core/globals.ml

@@ -10,6 +10,25 @@ module IntMap = Map.Make(struct type t = int let compare i1 i2 = i2 - i1 end)
 module StringMap = Map.Make(struct type t = string let compare = String.compare end)
 module Int32Map = Map.Make(struct type t = Int32.t let compare = Int32.compare end)
 
+module IntHashtbl = Hashtbl.Make(struct
+	type t = int
+
+	let equal =
+		Int.equal
+
+	let hash = Int.hash
+end)
+
+module StringHashtbl = Hashtbl.Make(struct
+	type t = string
+
+	let equal =
+		String.equal
+
+	let hash s =
+		Hashtbl.hash s
+end)
+
 type platform =
 	| Cross
 	| Js
@@ -152,6 +171,8 @@ let s_version_full v =
 
 let patch_string_pos p s = { p with pmin = p.pmax - String.length s }
 
+let gen_local_prefix = "`"
+
 (* msg * backtrace *)
 exception Ice of string * string
 

+ 10 - 10
src/core/json/genjson.ml

@@ -727,13 +727,13 @@ let create_context ?jsonrpc gm = {
 	request = match jsonrpc with None -> None | Some jsonrpc -> Some (new JsonRequest.json_request jsonrpc)
 }
 
-let generate types file =
-	let t = Timer.timer ["generate";"json";"construct"] in
-	let ctx = create_context GMFull in
-	let json = jarray (List.map (generate_module_type ctx) types) in
-	t();
-	let t = Timer.timer ["generate";"json";"write"] in
-	let ch = open_out_bin file in
-	Json.write_json (output_string ch) json;
-	close_out ch;
-	t()
+let generate timer_ctx types file =
+	let json = Timer.time timer_ctx ["generate";"json";"construct"] (fun () ->
+		let ctx = create_context GMFull in
+		jarray (List.map (generate_module_type ctx) types)
+	) () in
+	Timer.time timer_ctx ["generate";"json";"write"] (fun () ->
+		let ch = open_out_bin file in
+		Json.write_json (output_string ch) json;
+		close_out ch;
+	) ()

+ 3 - 1
src/core/path.ml

@@ -317,6 +317,8 @@ let module_name_of_file file =
 	| [] ->
 		Globals.die "" __LOC__
 
+let mkdir_mutex = Mutex.create ()
+
 let rec create_file bin ext acc = function
 	| [] -> Globals.die "" __LOC__
 	| d :: [] ->
@@ -327,7 +329,7 @@ let rec create_file bin ext acc = function
 		ch
 	| d :: l ->
 		let dir = String.concat "/" (List.rev (d :: acc)) in
-		if not (Sys.file_exists (remove_trailing_slash dir)) then Unix.mkdir dir 0o755;
+		Mutex.protect mkdir_mutex (fun () -> if not (Sys.file_exists (remove_trailing_slash dir)) then Unix.mkdir dir 0o755);
 		create_file bin ext (d :: acc) l
 
 let rec mkdir_recursive base dir_list =

+ 10 - 6
src/core/tFunctions.ml

@@ -71,14 +71,14 @@ let has_var_flag v (flag : flag_tvar) =
 (* ======= General utility ======= *)
 
 let alloc_var' =
-	let uid = ref 0 in
+	let uid = Atomic.make 0 in
 	uid,(fun kind n t p ->
-		incr uid;
+		Atomic.incr uid;
 		{
 			v_kind = kind;
 			v_name = n;
 			v_type = t;
-			v_id = !uid;
+			v_id = Atomic.get uid;
 			v_extra = None;
 			v_meta = [];
 			v_pos = p;
@@ -307,15 +307,19 @@ let null_abstract = {
 let create_dependency mdep origin =
 	{md_sign = mdep.m_extra.m_sign; md_path = mdep.m_path; md_kind = mdep.m_extra.m_kind; md_origin = origin}
 
+let add_dependency_mutex = Mutex.create ()
+
 let add_dependency ?(skip_postprocess=false) m mdep = function
 	(* These module dependency origins should not add as a dependency *)
 	| MDepFromMacroInclude -> ()
 
 	| origin ->
 		if m != null_module && mdep != null_module && (m.m_path != mdep.m_path || m.m_extra.m_sign != mdep.m_extra.m_sign) then begin
-			m.m_extra.m_deps <- PMap.add mdep.m_id (create_dependency mdep origin) m.m_extra.m_deps;
-			(* In case the module is cached, we'll have to run post-processing on it again (issue #10635) *)
-			if not skip_postprocess then m.m_extra.m_processed <- 0
+			Mutex.protect add_dependency_mutex (fun () ->
+				m.m_extra.m_deps <- PMap.add mdep.m_id (create_dependency mdep origin) m.m_extra.m_deps;
+				(* In case the module is cached, we'll have to run post-processing on it again (issue #10635) *)
+				if not skip_postprocess then m.m_extra.m_processed <- 0
+			)
 		end
 
 let arg_name (a,_) = a.v_name

+ 2 - 2
src/core/tPrinting.ml

@@ -30,7 +30,7 @@ let s_module_type_kind = function
 
 
 module MonomorphPrinting = struct
-	let show_mono_ids = true
+	let show_mono_ids = ref true
 
 	let s_mono_constraint_kind s_type constr =
 		let rec loop = function
@@ -42,7 +42,7 @@ module MonomorphPrinting = struct
 		loop constr
 
 	let print_mono_name m id extra =
-		let s = if show_mono_ids then
+		let s = if !show_mono_ids then
 			Printf.sprintf "Unknown<%d>" id
 		else
 			"Unknown"

+ 56 - 45
src/core/tUnification.ml

@@ -40,6 +40,10 @@ type type_param_mode =
 	| TpDefault
 	| TpDefinition of type_param_unification_context
 
+type 'a rec_stack = {
+	mutable rec_stack : 'a list;
+}
+
 type unification_context = {
 	allow_transitive_cast   : bool;
 	allow_abstract_cast     : bool; (* allows a non-transitive abstract cast (from,to,@:from,@:to) *)
@@ -49,6 +53,11 @@ type unification_context = {
 	equality_underlying     : bool;
 	strict_field_kind       : bool;
 	type_param_mode         : type_param_mode;
+	unify_stack             : (t * t) rec_stack;
+	eq_stack                : (t * t) rec_stack;
+	variance_stack          : (t * t) rec_stack;
+	abstract_cast_stack     : (t * t) rec_stack;
+	unify_new_monos         : t rec_stack;
 }
 
 type unify_min_result =
@@ -66,7 +75,9 @@ let check_constraint name f =
 let unify_ref : (unification_context -> t -> t -> unit) ref = ref (fun _ _ _ -> ())
 let unify_min_ref : (unification_context -> t -> t list -> unify_min_result) ref = ref (fun _ _ _ -> assert false)
 
-let default_unification_context = {
+let new_rec_stack() = { rec_stack = [] }
+
+let default_unification_context () = {
 	allow_transitive_cast   = true;
 	allow_abstract_cast     = true;
 	allow_dynamic_to_cast   = true;
@@ -75,6 +86,11 @@ let default_unification_context = {
 	equality_underlying     = false;
 	strict_field_kind       = false;
 	type_param_mode         = TpDefault;
+	unify_stack             = new_rec_stack();
+	eq_stack                = new_rec_stack();
+	variance_stack          = new_rec_stack();
+	abstract_cast_stack     = new_rec_stack();
+	unify_new_monos         = new_rec_stack();
 }
 
 (* Unify like targets (e.g. Java) probably would. *)
@@ -87,6 +103,11 @@ let native_unification_context = {
 	allow_arg_name_mismatch = true;
 	strict_field_kind       = false;
 	type_param_mode         = TpDefault;
+	unify_stack             = new_rec_stack();
+	eq_stack                = new_rec_stack();
+	variance_stack          = new_rec_stack();
+	abstract_cast_stack     = new_rec_stack();
+	unify_new_monos         = new_rec_stack();
 }
 
 module Monomorph = struct
@@ -193,14 +214,14 @@ module Monomorph = struct
 			()
 		| CTypes tl ->
 			List.iter (fun (t2,name) ->
-				let f () = (!unify_ref) default_unification_context t t2 in
+				let f () = (!unify_ref) (default_unification_context()) t t2 in
 				match name with
 				| Some name -> check_constraint name f
 				| None -> f()
 			) tl
 		| CStructural(fields,is_open) ->
 			let t2 = mk_anon ~fields (ref Closed) in
-			(!unify_ref) default_unification_context t t2
+			(!unify_ref) (default_unification_context()) t t2
 		| CMixed l ->
 			List.iter (fun constr -> check_down_constraints constr t) l
 
@@ -224,7 +245,7 @@ module Monomorph = struct
 	let check_up_constraints m t =
 		List.iter (fun (t2,constraint_name) ->
 			let check() =
-				(!unify_ref) default_unification_context t2 t
+				(!unify_ref) (default_unification_context()) t2 t
 			in
 			match constraint_name with
 			| Some name -> check_constraint name check
@@ -519,11 +540,6 @@ let unify_kind ~(strict:bool) k1 k2 =
 				| _ -> false)
 		| _ -> false
 
-type 'a rec_stack = {
-	mutable rec_stack : 'a list;
-}
-
-let new_rec_stack() = { rec_stack = [] }
 let rec_stack_exists f s = List.exists f s.rec_stack
 let rec_stack_memq v s = List.memq v s.rec_stack
 let rec_stack_loop stack value f arg =
@@ -536,8 +552,6 @@ let rec_stack_loop stack value f arg =
 		stack.rec_stack <- List.tl stack.rec_stack;
 		raise e
 
-let eq_stack = new_rec_stack()
-
 let rec_stack stack value fcheck frun ferror =
 	if not (rec_stack_exists fcheck stack) then begin
 		try
@@ -604,11 +618,11 @@ let rec type_eq uctx a b =
 	| TType (t1,tl1), TType (t2,tl2) when (t1 == t2 || (param = EqCoreType && t1.t_path = t2.t_path)) && List.length tl1 = List.length tl2 ->
 		type_eq_params uctx a b tl1 tl2
 	| TType (t,tl) , _ when can_follow a ->
-		rec_stack eq_stack (a,b) (fast_eq_pair (a,b))
+		rec_stack uctx.eq_stack (a,b) (fast_eq_pair (a,b))
 			(fun() -> try_apply_params_rec t.t_params tl t.t_type (fun a -> type_eq uctx a b))
 			(fun l -> error (cannot_unify a b :: l))
 	| _ , TType (t,tl) when can_follow b ->
-		rec_stack eq_stack (a,b) (fast_eq_pair (a,b))
+		rec_stack uctx.eq_stack (a,b) (fast_eq_pair (a,b))
 			(fun() -> try_apply_params_rec t.t_params tl t.t_type (type_eq uctx a))
 			(fun l -> error (cannot_unify a b :: l))
 	| TEnum (e1,tl1) , TEnum (e2,tl2) ->
@@ -711,27 +725,22 @@ let type_iseq uctx a b =
 
 let type_iseq_strict a b =
 	try
-		type_eq {default_unification_context with equality_kind = EqStricter} a b;
+		type_eq {(default_unification_context()) with equality_kind = EqStricter} a b;
 		true
 	with Unify_error _ ->
 		false
 
-let unify_stack = new_rec_stack()
-let variance_stack = new_rec_stack()
-let abstract_cast_stack = new_rec_stack()
-let unify_new_monos = new_rec_stack()
-
-let print_stacks() =
+let print_stacks uctx =
 	let ctx = print_context() in
 	let st = s_type ctx in
 	print_endline "unify_stack";
-	List.iter (fun (a,b) -> Printf.printf "\t%s , %s\n" (st a) (st b)) unify_stack.rec_stack;
+	List.iter (fun (a,b) -> Printf.printf "\t%s , %s\n" (st a) (st b)) uctx.unify_stack.rec_stack;
 	print_endline "variance_stack";
-	List.iter (fun (a,b) -> Printf.printf "\t%s , %s\n" (st a) (st b)) variance_stack.rec_stack;
+	List.iter (fun (a,b) -> Printf.printf "\t%s , %s\n" (st a) (st b)) uctx.variance_stack.rec_stack;
 	print_endline "monos";
-	List.iter (fun m -> print_endline ("\t" ^ st m)) unify_new_monos.rec_stack;
+	List.iter (fun m -> print_endline ("\t" ^ st m)) uctx.unify_new_monos.rec_stack;
 	print_endline "abstract_cast_stack";
-	List.iter (fun (a,b) -> Printf.printf "\t%s , %s\n" (st a) (st b)) abstract_cast_stack.rec_stack
+	List.iter (fun (a,b) -> Printf.printf "\t%s , %s\n" (st a) (st b)) uctx.abstract_cast_stack.rec_stack
 
 let rec unify (uctx : unification_context) a b =
 	if a == b then
@@ -748,12 +757,12 @@ let rec unify (uctx : unification_context) a b =
 		| None -> if uctx.equality_kind = EqStricter || not (link uctx t b a) then error [cannot_unify a b]
 		| Some t -> unify uctx a t)
 	| TType (t,tl) , _ ->
-		rec_stack unify_stack (a,b)
+		rec_stack uctx.unify_stack (a,b)
 			(fun(a2,b2) -> fast_eq_unbound_mono a a2 && fast_eq b b2)
 			(fun() -> try_apply_params_rec t.t_params tl t.t_type (fun a -> unify uctx a b))
 			(fun l -> error (cannot_unify a b :: l))
 	| _ , TType (t,tl) ->
-		rec_stack unify_stack (a,b)
+		rec_stack uctx.unify_stack (a,b)
 			(fun(a2,b2) -> fast_eq a a2 && fast_eq_unbound_mono b b2)
 			(fun() -> try_apply_params_rec t.t_params tl t.t_type (unify uctx a))
 			(fun l -> error (cannot_unify a b :: l))
@@ -859,22 +868,22 @@ let rec unify (uctx : unification_context) a b =
 				(match f2.cf_kind with
 				| Var { v_read = AccNo } | Var { v_read = AccNever } ->
 					(* we will do a recursive unification, so let's check for possible recursion *)
-					let old_monos = unify_new_monos.rec_stack in
-					unify_new_monos.rec_stack <- !monos @ unify_new_monos.rec_stack;
-					rec_stack unify_stack (ft,f2.cf_type)
-						(fun (a2,b2) -> fast_eq b2 f2.cf_type && fast_eq_mono unify_new_monos.rec_stack ft a2)
-						(fun() -> try unify_with_access uctx f1 ft f2 with e -> unify_new_monos.rec_stack <- old_monos; raise e)
+					let old_monos = uctx.unify_new_monos.rec_stack in
+					uctx.unify_new_monos.rec_stack <- !monos @ uctx.unify_new_monos.rec_stack;
+					rec_stack uctx.unify_stack (ft,f2.cf_type)
+						(fun (a2,b2) -> fast_eq b2 f2.cf_type && fast_eq_mono uctx.unify_new_monos.rec_stack ft a2)
+						(fun() -> try unify_with_access uctx f1 ft f2 with e -> uctx.unify_new_monos.rec_stack <- old_monos; raise e)
 						(fun l -> error (invalid_field n :: l));
-					unify_new_monos.rec_stack <- old_monos;
+					uctx.unify_new_monos.rec_stack <- old_monos;
 				| Method MethNormal | Method MethInline | Var { v_write = AccNo } | Var { v_write = AccNever } ->
 					(* same as before, but unification is reversed (read-only var) *)
-					let old_monos = unify_new_monos.rec_stack in
-					unify_new_monos.rec_stack <- !monos @ unify_new_monos.rec_stack;
-					rec_stack unify_stack (f2.cf_type,ft)
-						(fun(a2,b2) -> fast_eq_mono unify_new_monos.rec_stack b2 ft && fast_eq f2.cf_type a2)
-						(fun() -> try unify_with_access uctx f1 ft f2 with e -> unify_new_monos.rec_stack <- old_monos; raise e)
+					let old_monos = uctx.unify_new_monos.rec_stack in
+					uctx.unify_new_monos.rec_stack <- !monos @ uctx.unify_new_monos.rec_stack;
+					rec_stack uctx.unify_stack (f2.cf_type,ft)
+						(fun(a2,b2) -> fast_eq_mono uctx.unify_new_monos.rec_stack b2 ft && fast_eq f2.cf_type a2)
+						(fun() -> try unify_with_access uctx f1 ft f2 with e -> uctx.unify_new_monos.rec_stack <- old_monos; raise e)
 						(fun l -> error (invalid_field n :: l));
-					unify_new_monos.rec_stack <- old_monos;
+					uctx.unify_new_monos.rec_stack <- old_monos;
 				| _ ->
 					(* will use fast_eq, which have its own stack *)
 					try
@@ -1074,7 +1083,7 @@ and get_nested_context uctx =
 	{uctx with allow_abstract_cast = true}
 
 and unifies_with_abstract uctx a b f =
-	rec_stack_default abstract_cast_stack (a,b) (fast_eq_pair (a,b)) (fun() ->
+	rec_stack_default uctx.abstract_cast_stack (a,b) (fast_eq_pair (a,b)) (fun() ->
 		(uctx.allow_transitive_cast && f {uctx with allow_transitive_cast = false}) || f uctx
 	) false
 
@@ -1153,7 +1162,7 @@ and unify_with_variance uctx f t1 t2 =
 	let t1 = follow_without_type t1 in
 	let t2 = follow_without_type t2 in
 	let fail () = error [cannot_unify t1 t2] in
-	let unify_rec f = rec_stack variance_stack (t1,t2) (fast_eq_pair (t1,t2)) f (fun _ -> fail()) in
+	let unify_rec f = rec_stack uctx.variance_stack (t1,t2) (fast_eq_pair (t1,t2)) f (fun _ -> fail()) in
 	let unify_nested t1 t2 = with_variance (get_nested_context uctx) f t1 t2 in
 	let unify_tls tl1 tl2 = List.iter2 unify_nested tl1 tl2 in
 	let get_this_type ab tl = follow_without_type (apply_params ab.a_params tl ab.a_this) in
@@ -1162,7 +1171,7 @@ and unify_with_variance uctx f t1 t2 =
 	let unifies_abstract uctx a b ab tl ats =
 		try
 			let uctx = get_abstract_context uctx a b ab in
-			rec_stack_default abstract_cast_stack (a,b) (fast_eq_pair (a,b)) (fun() ->
+			rec_stack_default uctx.abstract_cast_stack (a,b) (fast_eq_pair (a,b)) (fun() ->
 				List.exists (does_func_unify_arg (fun at ->
 					let at = apply_params ab.a_params tl at in
 					if ats == ab.a_to then
@@ -1242,19 +1251,21 @@ and unify_with_access uctx f1 t1 f2 =
 
 let does_unify a b =
 	try
-		unify default_unification_context a b;
+		unify (default_unification_context()) a b;
 		true
 	with Unify_error _ ->
 		false
 
 let unify_custom = unify
-let unify = unify default_unification_context
+let unify a b = unify (default_unification_context()) a b
 
 let type_eq_custom = type_eq
-let type_eq param = type_eq {default_unification_context with equality_kind = param}
+
+let type_eq param a b = type_eq {(default_unification_context()) with equality_kind = param} a b
 
 let type_iseq_custom = type_iseq
-let type_iseq = type_iseq default_unification_context
+
+let type_iseq a b = type_iseq (default_unification_context ()) a b
 
 module UnifyMinT = struct
 	let collect_base_types t =

+ 84 - 109
src/core/timer.ml

@@ -1,96 +1,90 @@
-(*
-	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.
- *)
-
-type timer_infos = {
+type timer = {
 	id : string list;
-	mutable start : float list;
-	mutable pauses : float list;
 	mutable total : float;
+	mutable pauses : float;
 	mutable calls : int;
 }
 
-let measure_times = ref false
+type measure_times =
+	| Yes
+	| No
+	| Maybe
+
+type timer_context = {
+	root_timer : timer;
+	mutable current : timer;
+	mutable measure_times : measure_times;
+	start_time : float;
+	timer_lut : (string list,timer) Hashtbl.t;
+}
 
-let get_time = Extc.time
-let htimers = Hashtbl.create 0
+let make id = {
+	id = id;
+	total = 0.;
+	pauses = 0.;
+	calls = 0;
+}
 
-let new_timer id =
-	let now = get_time() in
-	try
-		let t = Hashtbl.find htimers id in
-		t.start <- now :: t.start;
-		t.pauses <- 0. :: t.pauses;
-		t.calls <- t.calls + 1;
-		t
+let make_context root_timer =
+	let ctx = {
+		root_timer = root_timer;
+		current = root_timer;
+		timer_lut = Hashtbl.create 0;
+		measure_times = Maybe;
+		start_time = Extc.time();
+	} in
+	Hashtbl.add ctx.timer_lut root_timer.id root_timer;
+	ctx
+
+let update_timer timer start =
+	let now = Extc.time () in
+	let dt = now -. start in
+	timer.total <- timer.total +. dt -. timer.pauses;
+	dt
+
+let start_timer ctx id =
+	let start = Extc.time () in
+	let old = ctx.current in
+	let timer = try
+		Hashtbl.find ctx.timer_lut id
 	with Not_found ->
-		let t = { id = id; start = [now]; pauses = [0.]; total = 0.; calls = 1; } in
-		Hashtbl.add htimers id t;
-		t
-
-let curtime = ref []
-
-let rec close now t =
-	match !curtime with
-	| [] ->
-		failwith ("Timer " ^ (String.concat "." t.id) ^ " closed while not active")
-	| tt :: rest ->
-		if t == tt then begin
-			match t.start, t.pauses with
-			| start :: rest_start, pauses :: rest_pauses ->
-				let dt = now -. start in
-				t.total <- t.total +. dt -. pauses;
-				t.start <- rest_start;
-				t.pauses <- rest_pauses;
-				curtime := rest;
-				(match !curtime with
-				| [] -> ()
-				| current :: _ ->
-					match current.pauses with
-					| pauses :: rest -> current.pauses <- (dt +. pauses) :: rest
-					| _ -> Globals.die "" __LOC__
-				)
-			| _ -> Globals.die "" __LOC__
-		end else
-			close now tt
-
-let timer id =
-	if !measure_times then (
-		let t = new_timer id in
-		curtime := t :: !curtime;
-		(function() -> close (get_time()) t)
-	) else
-		(fun() -> ())
-
-let current_id() =
-	match !curtime with
-	| [] -> None
-	| t :: _ -> Some t.id
-
-let rec close_times() =
-	let now = get_time() in
-	match !curtime with
-	| [] -> ()
-	| t :: _ -> close now t; close_times()
-
-let close = close (get_time())
+		let timer = make id in
+		Hashtbl.add ctx.timer_lut id timer;
+		timer
+	in
+	timer.calls <- timer.calls + 1;
+	ctx.current <- timer;
+	(fun () ->
+		let dt = update_timer timer start in
+		timer.pauses <- 0.;
+		old.pauses <- old.pauses +. dt;
+		ctx.current <- old
+	)
+
+let start_timer ctx id = match id,ctx.measure_times with
+	| (_ :: _),(Yes | Maybe) when Domain.is_main_domain () ->
+		start_timer ctx id
+	| _ ->
+		(fun () -> ())
+
+let time ctx id f arg =
+	let close = start_timer ctx id in
+	Std.finally close f arg
+
+let determine_id level base_labels label1 label2 =
+	match level,label2 with
+	| 0,_ -> base_labels
+	| 1,_ -> base_labels @ label1
+	| _,Some label2 -> base_labels @ label1 @ [label2]
+	| _ -> base_labels
+
+let level_from_define defines define =
+	try
+		int_of_string (Define.defined_value defines define)
+	with _ ->
+		0
 
-(* Printing *)
+(* reporting *)
 
 let timer_threshold = 0.01
 
@@ -104,7 +98,8 @@ type timer_node = {
 	mutable children : timer_node list;
 }
 
-let build_times_tree () =
+let build_times_tree ctx =
+	ignore(update_timer ctx.root_timer ctx.start_time);
 	let nodes = Hashtbl.create 0 in
 	let rec root = {
 		name = "";
@@ -156,7 +151,7 @@ let build_times_tree () =
 		let node = loop root timer.id in
 		if not (List.memq node root.children) then
 			root.children <- node :: root.children
-	) htimers;
+	) ctx.timer_lut;
 	let max_name = ref 0 in
 	let max_calls = ref 0 in
 	let rec loop depth node =
@@ -175,8 +170,8 @@ let build_times_tree () =
 	loop 0 root;
 	!max_name,!max_calls,root
 
-let report_times print =
-	let max_name,max_calls,root = build_times_tree () in
+let report_times ctx print =
+	let max_name,max_calls,root = build_times_tree ctx in
 	let max_calls = String.length (string_of_int max_calls) in
 	print (Printf.sprintf "%-*s | %7s |   %% |  p%% | %*s | info" max_name "name" "time(s)" max_calls "#");
 	let sep = String.make (max_name + max_calls + 27) '-' in
@@ -192,24 +187,4 @@ let report_times print =
 	in
 	List.iter (loop 0) root.children;
 	print sep;
-	print_time "total" root
-
-class timer (id : string list) = object(self)
-	method run_finally : 'a . (unit -> 'a) -> (unit -> unit) -> 'a = fun f finally ->
-		let timer = timer id in
-		try
-			let r = f() in
-			timer();
-			finally();
-			r
-		with exc ->
-			timer();
-			finally();
-			raise exc
-
-	method run : 'a . (unit -> 'a) -> 'a = fun f ->
-		self#run_finally f (fun () -> ())
-
-	method nest (name : string) =
-		new timer (id @ [name])
-end
+	print_time "total" root

+ 6 - 10
src/core/warning.ml

@@ -11,7 +11,7 @@ type warning_option = {
 	wo_mode : warning_mode;
 }
 
-let parse_options s ps lexbuf =
+let parse_options lctx s ps lexbuf =
 	let fail msg p =
 		raise_typing_error msg {p with pmin = ps.pmin + p.pmin; pmax = ps.pmin + p.pmax}
 	in
@@ -22,7 +22,7 @@ let parse_options s ps lexbuf =
 			fail (Printf.sprintf "Unknown warning: %s" s) p
 		end
 	in
-	let parse_warning () = match Lexer.token lexbuf with
+	let parse_warning () = match Lexer.token lctx lexbuf with
 		| Const (Ident s),p ->
 			parse_string s p
 		| (_,p) ->
@@ -31,7 +31,7 @@ let parse_options s ps lexbuf =
 	let add acc mode warning =
 		{ wo_warning = warning; wo_mode = mode } :: acc
 	in
-	let rec next acc = match Lexer.token lexbuf with
+	let rec next acc = match Lexer.token lctx lexbuf with
 		| Binop OpAdd,_ ->
 			next (add acc WMEnable (parse_warning()))
 		| Binop OpSub,_ ->
@@ -44,13 +44,9 @@ let parse_options s ps lexbuf =
 	next []
 
 let parse_options s ps =
-	let restore = Lexer.reinit ps.pfile in
-	Std.finally (fun () ->
-		restore()
-	) (fun () ->
-		let lexbuf = Sedlexing.Utf8.from_string s in
-		parse_options s ps lexbuf
-	) ()
+	let lctx = Lexer.create_temp_ctx ps.pfile in
+	let lexbuf = Sedlexing.Utf8.from_string s in
+	parse_options lctx s ps lexbuf
 
 let from_meta ml =
 	let parse_arg e = match fst e with

+ 1 - 0
src/dune

@@ -22,6 +22,7 @@
 		unix ipaddr str bigarray threads dynlink
 		xml-light extlib sha terminal_size
 		luv
+		domainslib
 	)
 	(modules (:standard \ haxe prebuild))
 	(preprocess (per_module

+ 0 - 159
src/filters/defaultArguments.ml

@@ -1,159 +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
-
-(*
-	This Module Filter will go through all defined functions in all modules and change them
-	so they set all default arguments to be of a Nullable type, and adds the unroll from nullable to
-	the not-nullable type in the beginning of the function.
-*)
-
-let gen_check basic t nullable_var const pos =
-	let needs_cast t1 t2 =
-		let is_null t = match t with TAbstract ({a_path = ([],"Null")}, _) -> true | _ -> false in
-		(is_null t1) <> (is_null t2)
-	in
-
-	let const_t = const.etype in
-	let const = if needs_cast t const_t then mk_cast const t pos else const in
-
-	let arg = make_local nullable_var pos in
-	let arg = if needs_cast t nullable_var.v_type then mk_cast arg t pos else arg in
-
-	let check = binop Ast.OpEq (make_local nullable_var pos) (null nullable_var.v_type pos) basic.tbool pos in
-	mk (TIf (check, const, Some arg)) t pos
-
-let add_opt com block pos (var,opt) =
-	match opt with
-	| None | Some {eexpr = TConst TNull} ->
-		(var,opt)
-	| Some ({eexpr = TConst (TString str)} as e) ->
-		block := Texpr.set_default com.basic var e pos :: !block;
-		(var, opt)
-	| Some const ->
-		let basic = com.basic in
-		let nullable_var = alloc_var var.v_kind var.v_name (basic.tnull var.v_type) pos in
-		(* var v = (temp_var == null) ? const : cast temp_var; *)
-		let evar = mk (TVar(var, Some(gen_check basic var.v_type nullable_var const pos))) basic.tvoid pos in
-		block := evar :: !block;
-		(nullable_var, opt)
-
-let rec change_func com cl cf =
-	List.iter (change_func com cl) cf.cf_overloads;
-
-	match cf.cf_kind, follow cf.cf_type with
-	| _ when has_class_field_flag cf CfPostProcessed ->
-		()
-	| Var _, _ | Method MethDynamic, _ ->
-		()
-	| _, TFun(args, ret) ->
-		let is_ctor = cf.cf_name = "new" in
-		let basic = com.basic in
-
-		let found = ref false in
-
-		let args = ref (List.map (fun (n,opt,t) ->
-			(n,opt, if opt then (found := true; basic.tnull t) else t)
-		) args) in
-
-		(match !found, cf.cf_expr with
-		| true, Some ({ eexpr = TFunction tf } as texpr) ->
-			let block = ref [] in
-			let tf_args = List.map (add_opt com block tf.tf_expr.epos) tf.tf_args in
-			let arg_assoc = List.map2 (fun (v,o) (v2,_) -> v,(v2,o) ) tf.tf_args tf_args in
-			let rec extract_super e = match e.eexpr with
-				| TBlock (({ eexpr = TCall ({ eexpr = TConst TSuper }, _) } as e2) :: tl) ->
-					e2, tl
-				| TBlock (hd :: tl) ->
-					let e2, tl2 = extract_super hd in
-					e2, tl2 @ tl
-				| _ ->
-					raise Not_found
-			in
-			let block =
-				try
-					if not is_ctor then raise Not_found;
-
-					(* issue #2570 *)
-					(* check if the class really needs the super as the first statement -
-					just to make sure we don't inadvertently break any existing code *)
-					let rec check cl =
-						if not (Meta.has Meta.HxGen cl.cl_meta) then
-							()
-						else match cl.cl_super with
-							| None ->
-								raise Not_found
-							| Some (cl, _) ->
-								check cl
-					in
-					check cl;
-
-					let super, tl = extract_super tf.tf_expr in
-					(match super.eexpr with
-					| TCall ({ eexpr = TConst TSuper } as e1, args) ->
-						(* any super argument will be replaced by an inlined version of the check *)
-						let found = ref false in
-						let rec replace_args e =
-							match e.eexpr with
-							| TLocal v ->
-								(try
-									let v2,o = List.assq v arg_assoc in
-									let o = match o with
-									| None -> raise Not_found
-									| Some o -> o
-									in
-									found := true;
-									gen_check com.basic v.v_type v2 o e.epos
-								with Not_found -> e)
-							| _ ->
-								Type.map_expr replace_args e
-						in
-						let args = List.map replace_args args in
-						{ tf.tf_expr with eexpr = TBlock ((if !found then { super with eexpr = TCall (e1, args) } else super) :: !block @ tl) }
-					| _ -> Globals.die "" __LOC__)
-				with Not_found ->
-					Type.concat { tf.tf_expr with eexpr = TBlock !block; etype = basic.tvoid } tf.tf_expr
-			in
-
-			args := List.map (fun (v,s) -> (v.v_name, (s <> None), v.v_type)) tf_args;
-
-			let cf_type = TFun (!args, ret) in
-			cf.cf_expr <- Some { texpr with
-				eexpr = TFunction { tf with
-					tf_args = tf_args;
-					tf_expr = block
-				};
-				etype = cf_type
-			};
-			cf.cf_type <- cf_type
-
-		| _ -> ());
-		(if !found then cf.cf_type <- TFun(!args, ret))
-	| _, _ -> Globals.die "" __LOC__
-
-let run com md =
-	match md with
-	| TClassDecl cl ->
-		let apply = change_func com cl in
-		List.iter apply cl.cl_ordered_fields;
-		List.iter apply cl.cl_ordered_statics;
-		Option.may apply cl.cl_constructor;
-	| _ -> ()

+ 47 - 0
src/filters/exception/exceptionFunctions.ml

@@ -0,0 +1,47 @@
+open Type
+
+let haxe_exception_type_path = (["haxe"],"Exception")
+let value_exception_type_path = (["haxe"],"ValueException")
+
+(**
+	Check if `cls` is or extends (if `check_parent=true`) `haxe.Exception`
+*)
+let rec is_haxe_exception_class ?(check_parent=true) cls =
+	cls.cl_path = haxe_exception_type_path
+	|| (check_parent && match cls.cl_super with
+		| None -> false
+		| Some (cls, _) -> is_haxe_exception_class ~check_parent cls
+	)
+
+(**
+	Check if `t` is or extends `haxe.Exception`
+*)
+let is_haxe_exception ?(check_parent=true) (t:Type.t) =
+	match Abstract.follow_with_abstracts t with
+		| TInst (cls, _) -> is_haxe_exception_class ~check_parent cls
+		| _ -> false
+
+let is_dynamic t =
+	match Abstract.follow_with_abstracts t with
+	| TAbstract({ a_path = [],"Dynamic" }, _) -> true
+	| t -> t == t_dynamic
+
+let make_call scom eon el tret p =
+	let default () =
+		mk (TCall(eon,el)) tret p
+	in
+	match eon.eexpr with
+	| TField(ef,(FStatic(cl,cf) | FInstance(cl,_,cf))) when SafeCom.needs_inline scom (Some cl) cf ->
+		begin match cf.cf_expr with
+		| Some {eexpr = TFunction tf} ->
+			let config = Inline.inline_config (Some cl) cf el tret in
+			Inline.type_inline (Inline.context_of_scom scom) cf tf ef el tret config p false
+		| _ ->
+			default ()
+		end
+	| _ ->
+		default ()
+
+let make_static_call scom c cf el tret p =
+	let ef = Texpr.Builder.make_static_field c cf p in
+	make_call scom ef el tret p

+ 78 - 0
src/filters/exception/exceptionInit.ml

@@ -0,0 +1,78 @@
+open Globals
+open Ast
+open Common
+open Error
+open Exceptions
+open Type
+open Typecore
+open ExceptionFunctions
+
+let create_exception_context tctx =
+	match tctx.com.platform with (* TODO: implement for all targets *)
+	| Php | Js | Jvm | Python | Lua | Eval | Neko | Flash | Hl | Cpp ->
+		let config = tctx.com.config.pf_exceptions in
+		let tp (pack,name) =
+			let tp = match List.rev pack with
+			| module_name :: pack_rev when not (Ast.is_lower_ident module_name) ->
+				mk_type_path ~sub:name (List.rev pack_rev,module_name)
+			| _ ->
+				mk_type_path (pack,name)
+			in
+			make_ptp tp null_pos
+		in
+		let wildcard_catch_type =
+			let t = Typeload.load_instance tctx (tp config.ec_wildcard_catch) ParamSpawnMonos LoadNormal in
+			if is_dynamic t then t_dynamic
+			else t
+		and base_throw_type =
+			let t = Typeload.load_instance tctx (tp config.ec_base_throw) ParamSpawnMonos LoadNormal in
+			if is_dynamic t then t_dynamic
+			else t
+		and haxe_exception_type, haxe_exception_class =
+			match Typeload.load_instance tctx (tp haxe_exception_type_path) ParamSpawnMonos LoadNormal with
+			| TInst(cls,_) as t -> t,cls
+			| _ -> raise_typing_error "haxe.Exception is expected to be a class" null_pos
+		and value_exception_type, value_exception_class =
+			match Typeload.load_instance tctx (tp value_exception_type_path) ParamSpawnMonos LoadNormal with
+			| TInst(cls,_) as t -> t,cls
+			| _ -> raise_typing_error "haxe.ValueException is expected to be a class" null_pos
+		and haxe_native_stack_trace =
+			match Typeload.load_instance tctx (tp (["haxe"],"NativeStackTrace")) ParamSpawnMonos LoadNormal with
+			| TInst(cls,_) -> cls
+			| TAbstract({ a_impl = Some cls },_) -> cls
+			| _ -> raise_typing_error "haxe.NativeStackTrace is expected to be a class or an abstract" null_pos
+		in
+		let is_path_of_dynamic (pack,name) =
+			name = "Dynamic" && (pack = [] || pack = ["StdTypes"])
+		in
+		let is_of_type =
+			let std_cls = tctx.com.std in
+			let isOfType_field =
+				try PMap.find "isOfType" std_cls.cl_statics
+				with Not_found -> raise_typing_error ("Std has no field isOfType") null_pos
+			in
+			let return_type =
+				match follow isOfType_field.cf_type with
+				| TFun(_,t) -> t
+				| _ -> raise_typing_error ("Std.isOfType is not a function and cannot be called") null_pos
+			in
+			(std_cls,isOfType_field,return_type)
+		in
+		let ctx = {
+			scom = SafeCom.of_typer tctx;
+			basic = tctx.t;
+			config = config;
+			wildcard_catch_type = wildcard_catch_type;
+			base_throw_type = base_throw_type;
+			throws_anything = is_path_of_dynamic config.ec_base_throw && config.ec_avoid_wrapping;
+			catches_anything = is_path_of_dynamic config.ec_wildcard_catch && config.ec_avoid_wrapping;
+			haxe_exception_class = haxe_exception_class;
+			haxe_exception_type = haxe_exception_type;
+			haxe_native_stack_trace = haxe_native_stack_trace;
+			value_exception_type = value_exception_type;
+			value_exception_class = value_exception_class;
+			is_of_type = is_of_type;
+		} in
+		Some ctx
+	| Cross | CustomTarget _ ->
+		None

+ 10 - 217
src/filters/exceptions.ml → src/filters/exception/exceptions.ml

@@ -1,13 +1,11 @@
 open Globals
-open Ast
 open Type
-open Common
-open Typecore
+open PlatformConfig
 open Error
 open ExceptionFunctions
 
 type context = {
-	typer : typer;
+	scom : SafeCom.t;
 	basic : basic_types;
 	config : exceptions_config;
 	wildcard_catch_type : Type.t;
@@ -19,13 +17,9 @@ type context = {
 	haxe_native_stack_trace : tclass;
 	value_exception_type : Type.t;
 	value_exception_class : tclass;
+	is_of_type : (tclass * tclass_field * Type.t);
 }
 
-let is_dynamic t =
-	match Abstract.follow_with_abstracts t with
-	| TAbstract({ a_path = [],"Dynamic" }, _) -> true
-	| t -> t == t_dynamic
-
 (**
 	Generate `haxe.Exception.method_name(args)`
 *)
@@ -39,8 +33,8 @@ let haxe_exception_static_call ctx method_name args p =
 		| TFun(_,t) -> t
 		| _ -> raise_typing_error ("haxe.Exception." ^ method_name ^ " is not a function and cannot be called") p
 	in
-	add_dependency ctx.typer.c.curclass.cl_module ctx.haxe_exception_class.cl_module MDepFromTyping;
-	CallUnification.make_static_call_better ctx.typer ctx.haxe_exception_class method_field [] args return_type p
+	add_dependency ctx.scom.curclass.cl_module ctx.haxe_exception_class.cl_module MDepFromTyping;
+	make_static_call ctx.scom ctx.haxe_exception_class method_field args return_type p
 
 (**
 	Generate `haxe_exception.method_name(args)`
@@ -55,7 +49,7 @@ let haxe_exception_instance_call ctx haxe_exception method_name args p =
 			| _ ->
 				raise_typing_error ((s_type (print_context()) haxe_exception.etype) ^ "." ^ method_name ^ " is not a function and cannot be called") p
 		in
-		make_call ctx.typer efield args rt p
+		make_call ctx.scom efield args rt p
 	| _ -> raise_typing_error ((s_type (print_context()) haxe_exception.etype) ^ "." ^ method_name ^ " is expected to be an instance method") p
 
 (**
@@ -63,18 +57,9 @@ let haxe_exception_instance_call ctx haxe_exception method_name args p =
 *)
 let std_is ctx e t p =
 	let t = follow t in
-	let std_cls = ctx.typer.com.std in
-	let isOfType_field =
-		try PMap.find "isOfType" std_cls.cl_statics
-		with Not_found -> raise_typing_error ("Std has no field isOfType") p
-	in
-	let return_type =
-		match follow isOfType_field.cf_type with
-		| TFun(_,t) -> t
-		| _ -> raise_typing_error ("Std.isOfType is not a function and cannot be called") p
-	in
-	let type_expr = TyperBase.type_module_type ctx.typer (module_type_of_type t) p in
-	CallUnification.make_static_call_better ctx.typer std_cls isOfType_field [] [e; type_expr] return_type p
+	let type_expr = TyperBase.type_module_type_simple (module_type_of_type t) p in
+	let (std_cls,isOfType_field,return_type) = ctx.is_of_type in
+	make_static_call ctx.scom std_cls isOfType_field [e; type_expr] return_type p
 
 (**
 	Check if type path of `t` exists in `lst`
@@ -492,62 +477,6 @@ let catch_native ctx catches t p =
 	in
 	transform [] None catches
 
-let create_exception_context tctx =
-	match tctx.com.platform with (* TODO: implement for all targets *)
-	| Php | Js | Jvm | Python | Lua | Eval | Neko | Flash | Hl | Cpp ->
-		let config = tctx.com.config.pf_exceptions in
-		let tp (pack,name) =
-			let tp = match List.rev pack with
-			| module_name :: pack_rev when not (Ast.is_lower_ident module_name) ->
-				mk_type_path ~sub:name (List.rev pack_rev,module_name)
-			| _ ->
-				mk_type_path (pack,name)
-			in
-			make_ptp tp null_pos
-		in
-		let wildcard_catch_type =
-			let t = Typeload.load_instance tctx (tp config.ec_wildcard_catch) ParamSpawnMonos LoadNormal in
-			if is_dynamic t then t_dynamic
-			else t
-		and base_throw_type =
-			let t = Typeload.load_instance tctx (tp config.ec_base_throw) ParamSpawnMonos LoadNormal in
-			if is_dynamic t then t_dynamic
-			else t
-		and haxe_exception_type, haxe_exception_class =
-			match Typeload.load_instance tctx (tp haxe_exception_type_path) ParamSpawnMonos LoadNormal with
-			| TInst(cls,_) as t -> t,cls
-			| _ -> raise_typing_error "haxe.Exception is expected to be a class" null_pos
-		and value_exception_type, value_exception_class =
-			match Typeload.load_instance tctx (tp value_exception_type_path) ParamSpawnMonos LoadNormal with
-			| TInst(cls,_) as t -> t,cls
-			| _ -> raise_typing_error "haxe.ValueException is expected to be a class" null_pos
-		and haxe_native_stack_trace =
-			match Typeload.load_instance tctx (tp (["haxe"],"NativeStackTrace")) ParamSpawnMonos LoadNormal with
-			| TInst(cls,_) -> cls
-			| TAbstract({ a_impl = Some cls },_) -> cls
-			| _ -> raise_typing_error "haxe.NativeStackTrace is expected to be a class or an abstract" null_pos
-		in
-		let is_path_of_dynamic (pack,name) =
-			name = "Dynamic" && (pack = [] || pack = ["StdTypes"])
-		in
-		let ctx = {
-			typer = tctx;
-			basic = tctx.t;
-			config = config;
-			wildcard_catch_type = wildcard_catch_type;
-			base_throw_type = base_throw_type;
-			throws_anything = is_path_of_dynamic config.ec_base_throw && config.ec_avoid_wrapping;
-			catches_anything = is_path_of_dynamic config.ec_wildcard_catch && config.ec_avoid_wrapping;
-			haxe_exception_class = haxe_exception_class;
-			haxe_exception_type = haxe_exception_type;
-			haxe_native_stack_trace = haxe_native_stack_trace;
-			value_exception_type = value_exception_type;
-			value_exception_class = value_exception_class;
-		} in
-		Some ctx
-	| Cross | CustomTarget _ ->
-		None
-
 (**
 	Transform `throw` and `try..catch` expressions.
 	`rename_locals` is required to deal with the names of temp vars.
@@ -574,140 +503,4 @@ let filter ectx =
 			else stub e
 		)
 	| None ->
-		stub
-
-(**
-	Inserts `haxe.NativeStackTrace.saveStack(e)` in non-haxe.Exception catches.
-*)
-let insert_save_stacks ectx =
-	let tctx = ectx.typer in
-	if not (has_feature tctx.com "haxe.NativeStackTrace.exceptionStack") then
-		(fun e -> e)
-	else
-		let native_stack_trace_cls = ectx.haxe_native_stack_trace in
-		let rec contains_insertion_points e =
-			match e.eexpr with
-			| TTry (e, catches) ->
-				List.exists (fun (v, _) -> Meta.has Meta.NeedsExceptionStack v.v_meta) catches
-				|| contains_insertion_points e
-				|| List.exists (fun (_, e) -> contains_insertion_points e) catches
-			| _ ->
-				check_expr contains_insertion_points e
-		in
-		let save_exception_stack catch_var =
-			(* GOTCHA: `has_feature` always returns `true` if executed before DCE filters *)
-			if has_feature tctx.com "haxe.NativeStackTrace.exceptionStack" then
-				let method_field =
-					try PMap.find "saveStack" native_stack_trace_cls.cl_statics
-					with Not_found -> raise_typing_error ("haxe.NativeStackTrace has no field saveStack") null_pos
-				in
-				let return_type =
-					match follow method_field.cf_type with
-					| TFun(_,t) -> t
-					| _ -> raise_typing_error ("haxe.NativeStackTrace." ^ method_field.cf_name ^ " is not a function and cannot be called") null_pos
-				in
-				let catch_local = mk (TLocal catch_var) catch_var.v_type catch_var.v_pos in
-				begin
-					add_dependency tctx.c.curclass.cl_module native_stack_trace_cls.cl_module MDepFromTyping;
-					CallUnification.make_static_call_better tctx native_stack_trace_cls method_field [] [catch_local] return_type catch_var.v_pos
-				end
-			else
-				mk (TBlock[]) tctx.t.tvoid catch_var.v_pos
-		in
-		let rec run e =
-			match e.eexpr with
-			| TTry (e1, catches) ->
-				let e1 = map_expr run e1 in
-				let catches =
-					List.map (fun ((v, body) as catch) ->
-						if Meta.has Meta.NeedsExceptionStack v.v_meta then
-							let exprs =
-								match body.eexpr with
-								| TBlock exprs ->
-									save_exception_stack v :: exprs
-								| _ ->
-									[save_exception_stack v; body]
-							in
-							(v, { body with eexpr = TBlock exprs })
-						else
-							catch
-					) catches
-				in
-				{ e with eexpr = TTry (e1, catches) }
-			| _ ->
-				map_expr run e
-		in
-		(fun e ->
-			if contains_insertion_points e then run e
-			else e
-		)
-
-let insert_save_stacks tctx ectx =
-	match ectx with
-	| Some ctx ->
-		insert_save_stacks {ctx with typer = tctx}
-	| None ->
-		(fun e -> e)
-
-(**
-	Adds `this.__shiftStack()` calls to constructors of classes which extend `haxe.Exception`
-*)
-let patch_constructors ectx =
-	let tctx = ectx.typer in
-	match ectx.haxe_exception_type with
-	(* Add only if `__shiftStack` method exists *)
-	| TInst(cls,_) when PMap.mem "__shiftStack" cls.cl_fields ->
-		(fun mt ->
-			match mt with
-			| TClassDecl cls when not (has_class_flag cls CExtern) && cls.cl_path <> haxe_exception_type_path && is_haxe_exception_class cls ->
-				let shift_stack p =
-					let t = type_of_module_type mt in
-					let this = { eexpr = TConst(TThis); etype = t; epos = p } in
-					let faccess =
-						try quick_field t "__shiftStack"
-						with Not_found -> raise_typing_error "haxe.Exception has no field __shiftStack" p
-					in
-					match faccess with
-					| FInstance (_,_,cf) ->
-						let efield = { eexpr = TField(this,faccess); etype = cf.cf_type; epos = p } in
-						let rt =
-							match follow cf.cf_type with
-							| TFun(_,t) -> t
-							| _ ->
-								raise_typing_error "haxe.Exception.__shiftStack is not a function and cannot be called" cf.cf_name_pos
-						in
-						make_call tctx efield [] rt p
-					| _ -> raise_typing_error "haxe.Exception.__shiftStack is expected to be an instance method" p
-				in
-				TypeloadFunction.add_constructor tctx cls true cls.cl_name_pos;
-				Option.may (fun cf -> ignore(follow cf.cf_type)) cls.cl_constructor;
-				(match cls.cl_constructor with
-				| Some ({ cf_expr = Some e_ctor } as ctor) ->
-					let rec add e =
-						match e.eexpr with
-						| TFunction _ -> e
-						| TReturn _ -> mk (TBlock [shift_stack e.epos; e]) e.etype e.epos
-						| _ -> map_expr add e
-					in
-					(ctor.cf_expr <- match e_ctor.eexpr with
-						| TFunction fn ->
-							Some { e_ctor with
-								eexpr = TFunction { fn with
-									tf_expr = mk (TBlock [add fn.tf_expr; shift_stack fn.tf_expr.epos]) tctx.t.tvoid fn.tf_expr.epos
-								}
-							}
-						| _ -> die "" __LOC__
-					)
-				| None -> die "" __LOC__
-				| _ -> ()
-				)
-			| _ -> ()
-		)
-	| _ -> (fun _ -> ())
-
-let patch_constructors tctx ectx =
-	match ectx with
-	| Some ctx ->
-		patch_constructors {ctx with typer = tctx}
-	| None ->
-		(fun _ -> ())
+		stub

+ 126 - 0
src/filters/exception/saveStacks.ml

@@ -0,0 +1,126 @@
+open Globals
+open SafeCom
+open Type
+open Error
+open ExceptionFunctions
+open Exceptions
+
+(**
+	Inserts `haxe.NativeStackTrace.saveStack(e)` in non-haxe.Exception catches.
+*)
+let insert_save_stacks ectx scom =
+	let native_stack_trace_cls = ectx.haxe_native_stack_trace in
+	let rec contains_insertion_points e =
+		match e.eexpr with
+		| TTry (e, catches) ->
+			List.exists (fun (v, _) -> Meta.has Meta.NeedsExceptionStack v.v_meta) catches
+			|| contains_insertion_points e
+			|| List.exists (fun (_, e) -> contains_insertion_points e) catches
+		| _ ->
+			check_expr contains_insertion_points e
+	in
+	let save_exception_stack catch_var =
+		let method_field =
+			try PMap.find "saveStack" native_stack_trace_cls.cl_statics
+			with Not_found -> raise_typing_error ("haxe.NativeStackTrace has no field saveStack") null_pos
+		in
+		let return_type =
+			match follow method_field.cf_type with
+			| TFun(_,t) -> t
+			| _ -> raise_typing_error ("haxe.NativeStackTrace." ^ method_field.cf_name ^ " is not a function and cannot be called") null_pos
+		in
+		let catch_local = mk (TLocal catch_var) catch_var.v_type catch_var.v_pos in
+		begin
+			add_dependency scom.curclass.cl_module native_stack_trace_cls.cl_module MDepFromTyping;
+			make_static_call scom native_stack_trace_cls method_field [catch_local] return_type catch_var.v_pos
+		end
+	in
+	let rec run e =
+		match e.eexpr with
+		| TTry (e1, catches) ->
+			let e1 = map_expr run e1 in
+			let catches =
+				List.map (fun ((v, body) as catch) ->
+					if Meta.has Meta.NeedsExceptionStack v.v_meta then
+						let exprs =
+							match body.eexpr with
+							| TBlock exprs ->
+								save_exception_stack v :: exprs
+							| _ ->
+								[save_exception_stack v; body]
+						in
+						(v, { body with eexpr = TBlock exprs })
+					else
+						catch
+				) catches
+			in
+			{ e with eexpr = TTry (e1, catches) }
+		| _ ->
+			map_expr run e
+	in
+	(fun e ->
+		if contains_insertion_points e then run e
+		else e
+	)
+
+(**
+	Adds `this.__shiftStack()` calls to constructors of classes which extend `haxe.Exception`
+*)
+let patch_constructors ectx =
+	match ectx.haxe_exception_type with
+	(* Add only if `__shiftStack` method exists *)
+	| TInst(cls,_) when PMap.mem "__shiftStack" cls.cl_fields ->
+		(fun mt ->
+			match mt with
+			| TClassDecl cls when not (has_class_flag cls CExtern) && cls.cl_path <> haxe_exception_type_path && is_haxe_exception_class cls ->
+				let shift_stack p =
+					let t = type_of_module_type mt in
+					let this = { eexpr = TConst(TThis); etype = t; epos = p } in
+					let faccess =
+						try quick_field t "__shiftStack"
+						with Not_found -> raise_typing_error "haxe.Exception has no field __shiftStack" p
+					in
+					match faccess with
+					| FInstance (_,_,cf) ->
+						let efield = { eexpr = TField(this,faccess); etype = cf.cf_type; epos = p } in
+						let rt =
+							match follow cf.cf_type with
+							| TFun(_,t) -> t
+							| _ ->
+								raise_typing_error "haxe.Exception.__shiftStack is not a function and cannot be called" cf.cf_name_pos
+						in
+						make_call ectx.scom efield [] rt p
+					| _ -> raise_typing_error "haxe.Exception.__shiftStack is expected to be an instance method" p
+				in
+				(* TypeloadFunction.add_constructor tctx cls true cls.cl_name_pos; *) (* TODO: why? *)
+				Option.may (fun cf -> ignore(follow cf.cf_type)) cls.cl_constructor;
+				(match cls.cl_constructor with
+				| Some ({ cf_expr = Some e_ctor } as ctor) ->
+					let rec add e =
+						match e.eexpr with
+						| TFunction _ -> e
+						| TReturn _ -> mk (TBlock [shift_stack e.epos; e]) e.etype e.epos
+						| _ -> map_expr add e
+					in
+					(ctor.cf_expr <- match e_ctor.eexpr with
+						| TFunction fn ->
+							Some { e_ctor with
+								eexpr = TFunction { fn with
+									tf_expr = mk (TBlock [add fn.tf_expr; shift_stack fn.tf_expr.epos]) ectx.scom.basic.tvoid fn.tf_expr.epos
+								}
+							}
+						| _ -> die "" __LOC__
+					)
+				| None -> die "" __LOC__
+				| _ -> ()
+				)
+			| _ -> ()
+		)
+	| _ -> (fun _ -> ())
+
+let patch_constructors ectx scom =
+	match ectx with
+	| Some ctx ->
+		patch_constructors {ctx with scom = scom}
+	| None ->
+		(fun _ -> ())

+ 0 - 22
src/filters/exceptionFunctions.ml

@@ -1,22 +0,0 @@
-open Type
-
-let haxe_exception_type_path = (["haxe"],"Exception")
-let value_exception_type_path = (["haxe"],"ValueException")
-
-(**
-	Check if `cls` is or extends (if `check_parent=true`) `haxe.Exception`
-*)
-	let rec is_haxe_exception_class ?(check_parent=true) cls =
-		cls.cl_path = haxe_exception_type_path
-		|| (check_parent && match cls.cl_super with
-			| None -> false
-			| Some (cls, _) -> is_haxe_exception_class ~check_parent cls
-		)
-	
-	(**
-		Check if `t` is or extends `haxe.Exception`
-	*)
-	let is_haxe_exception ?(check_parent=true) (t:Type.t) =
-		match Abstract.follow_with_abstracts t with
-			| TInst (cls, _) -> is_haxe_exception_class ~check_parent cls
-			| _ -> false

+ 30 - 9
src/filters/filterContext.ml

@@ -1,9 +1,30 @@
-let with_timer detail_times label identifier f =
-	let label = match detail_times,identifier with
-		| 0,_ -> ["filters"]
-		| 1,_ -> "filters" :: label :: []
-		| _,Some identifier -> "filters" :: label :: identifier :: []
-		| _ -> ["filters"]
-	in
-	let timer = Timer.timer label in
-	Std.finally timer f ()
+let with_timer timer_ctx level label identifier f =
+	let id = Timer.determine_id level ["filters"] [label] identifier in
+	Timer.time timer_ctx id f ()
+
+open Type
+
+let rec is_removable_class c =
+	match c.cl_kind with
+	| KGeneric ->
+		(Meta.has Meta.Remove c.cl_meta ||
+		(match c.cl_super with
+			| Some (c,_) -> is_removable_class c
+			| _ -> false) ||
+		List.exists (fun tp ->
+			has_ctor_constraint tp.ttp_class || Meta.has Meta.Const tp.ttp_class.cl_meta
+		) c.cl_params)
+	| KTypeParameter _ ->
+		(* this shouldn't happen, have to investigate (see #4092) *)
+		true
+	| _ ->
+		false
+
+let is_removable_field is_macro_context f =
+	not (has_class_field_flag f CfOverride) && (
+		has_class_field_flag f CfExtern || has_class_field_flag f CfGeneric
+		|| (match f.cf_kind with
+			| Var {v_read = AccRequire (s,_)} -> true
+			| Method MethMacro -> not is_macro_context
+			| _ -> false)
+	)

+ 149 - 383
src/filters/filters.ml

@@ -17,280 +17,19 @@
 	Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  *)
 
-open Ast
-open Common
 open Type
-open Typecore
+open SafeCom
 open Error
 open Globals
 open FiltersCommon
 
 let get_native_name = Native.get_native_name
 
-(* PASS 1 begin *)
-
-(* Adds final returns to functions as required by some platforms *)
-let rec add_final_return e =
-	let rec loop e t =
-		let def_return p =
-			let c = (match follow t with
-				| TAbstract ({ a_path = [],"Int" },_) -> TInt 0l
-				| TAbstract ({ a_path = [],"Float" },_) -> TFloat "0."
-				| TAbstract ({ a_path = [],"Bool" },_) -> TBool false
-				| _ -> TNull
-			) in
-			{ eexpr = TReturn (Some { eexpr = TConst c; epos = p; etype = t }); etype = t_dynamic; epos = p }
-		in
-		match e.eexpr with
-		| TBlock el ->
-			(match List.rev el with
-			| [] -> e
-			| elast :: el ->
-				match loop elast t with
-				| { eexpr = TBlock el2 } -> { e with eexpr = TBlock ((List.rev el) @ el2) }
-				| elast -> { e with eexpr = TBlock (List.rev (elast :: el)) })
-		| TReturn _ ->
-			e
-		| _ ->
-			{ e with eexpr = TBlock [e;def_return e.epos] }
-	in
-
-	let e = Type.map_expr add_final_return e in
-
-	match e.eexpr with
-		| TFunction f ->
-			let f = (match follow f.tf_type with
-				| TAbstract ({ a_path = [],"Void" },[]) -> f
-				| _ -> { f with tf_expr = loop f.tf_expr f.tf_type }
-			) in
-			{ e with eexpr = TFunction f }
-		| _ -> e
-
-(* -------------------------------------------------------------------------- *)
-(* CHECK LOCAL VARS INIT *)
-
-let check_local_vars_init ctx e =
-	let intersect vl1 vl2 =
-		PMap.mapi (fun v t -> t && PMap.find v vl2) vl1
-	in
-	let join vars cvars =
-		List.iter (fun v -> vars := intersect !vars v) cvars
-	in
-	let restore vars old_vars declared =
-		(* restore variables declared in this block to their previous state *)
-		vars := List.fold_left (fun acc v ->
-			try	PMap.add v (PMap.find v old_vars) acc with Not_found -> PMap.remove v acc
-		) !vars declared;
-	in
-	let declared = ref [] in
-	let outside_vars = ref IntMap.empty in
-	(* Set variables which belong to current function *)
-	let set_all_vars vars =
-		vars := PMap.mapi (fun id is_set -> if IntMap.mem id !outside_vars then is_set else true) !vars
-	in
-	let rec loop vars e =
-		match e.eexpr with
-		| TLocal v ->
-			let init = (try PMap.find v.v_id !vars with Not_found -> true) in
-			if not init then begin
-				if IntMap.mem v.v_id !outside_vars then
-					if v.v_name = "this" then warning ctx WVarInit "this might be used before assigning a value to it" e.epos
-					else warning ctx WVarInit ("Local variable " ^ v.v_name ^ " might be used before being initialized") e.epos
-				else
-					if v.v_name = "this" then raise_typing_error "Missing this = value" e.epos
-					else raise_typing_error ("Local variable " ^ v.v_name ^ " used without being initialized") e.epos
-			end
-		| TVar (v,eo) ->
-			begin
-				match eo with
-				| None when (match v.v_kind with VInlinedConstructorVariable _ -> true | _ -> false) ->
-					()
-				| None ->
-					declared := v.v_id :: !declared;
-					vars := PMap.add v.v_id false !vars
-				| Some e ->
-					loop vars e
-			end
-		| TBlock el ->
-			let old = !declared in
-			let old_vars = !vars in
-			declared := [];
-			List.iter (loop vars) el;
-			restore vars old_vars (List.rev !declared);
-			declared := old;
-		| TBinop (OpAssign,{ eexpr = TLocal v },e) when PMap.mem v.v_id !vars ->
-			begin match (Texpr.skip e).eexpr with
-				| TFunction _ ->
-					(* We can be sure that the function doesn't execute immediately, so it's fine to
-					   consider the local initialized (issue #9919). *)
-					vars := PMap.add v.v_id true !vars;
-					loop vars e;
-				| _ ->
-					loop vars e;
-					vars := PMap.add v.v_id true !vars
-			end
-		| TIf (e1,e2,eo) ->
-			loop vars e1;
-			let vbase = !vars in
-			loop vars e2;
-			(match eo with
-			| None -> vars := vbase
-			(* ignore else false cases (they are added by the side-effect handler) *)
-			| Some {eexpr = TConst (TBool(false))} -> ()
-			| Some e ->
-				let v1 = !vars in
-				vars := vbase;
-				loop vars e;
-				vars := intersect !vars v1)
-		| TWhile (cond,e,flag) ->
-			(match flag with
-			| NormalWhile when (match cond.eexpr with TParenthesis {eexpr = TConst (TBool true)} -> false | _ -> true) ->
-				loop vars cond;
-				let old = !vars in
-				loop vars e;
-				vars := old;
-			| _ ->
-				loop vars e;
-				loop vars cond)
-		| TTry (e,catches) ->
-			let cvars = List.map (fun (v,e) ->
-				let old = !vars in
-				loop vars e;
-				let v = !vars in
-				vars := old;
-				v
-			) catches in
-			loop vars e;
-			join vars cvars;
-		| TSwitch ({switch_subject = e;switch_cases = cases;switch_default = def} as switch) ->
-			loop vars e;
-			let cvars = List.map (fun {case_patterns = ec;case_expr = e} ->
-				let old = !vars in
-				List.iter (loop vars) ec;
-				vars := old;
-				loop vars e;
-				let v = !vars in
-				vars := old;
-				v
-			) cases in
-			(match def with
-			| None when switch.switch_exhaustive ->
-				(match cvars with
-				| cv :: cvars ->
-					PMap.iter (fun i b -> if b then vars := PMap.add i b !vars) cv;
-					join vars cvars
-				| [] -> ())
-			| None -> ()
-			| Some e ->
-				loop vars e;
-				join vars cvars)
-		(* mark all reachable vars as initialized, since we don't exit the block  *)
-		| TBreak | TContinue | TReturn None ->
-			set_all_vars vars
-		| TThrow e | TReturn (Some e) ->
-			loop vars e;
-			set_all_vars vars
-		| TFunction tf ->
-			let old = !outside_vars in
-			(* Mark all known variables as "outside" so we can ignore their initialization state within the function.
-			   We cannot use `vars` directly because we still care about initializations the function might make.
-			*)
-			PMap.iter (fun i _ -> outside_vars := IntMap.add i true !outside_vars) !vars;
-			loop vars tf.tf_expr;
-			outside_vars := old;
-		| _ ->
-			Type.iter (loop vars) e
-	in
-	loop (ref PMap.empty) e;
-	e
-
-let mark_switch_break_loops e =
-	let add_loop_label n e =
-		{ e with eexpr = TMeta ((Meta.LoopLabel,[(EConst(Int(string_of_int n, None)),e.epos)],e.epos), e) }
-	in
-	let in_switch = ref false in
-	let did_found = ref (-1) in
-	let num = ref 0 in
-	let cur_num = ref 0 in
-	let rec run e =
-		match e.eexpr with
-		| TFunction _ ->
-			let old_num = !num in
-			num := 0;
-				let ret = Type.map_expr run e in
-			num := old_num;
-			ret
-		| TWhile _ ->
-			let last_switch = !in_switch in
-			let last_found = !did_found in
-			let last_num = !cur_num in
-			in_switch := false;
-			incr num;
-			cur_num := !num;
-			did_found := -1;
-				let new_e = Type.map_expr run e in (* assuming that no loop will be found in the condition *)
-				let new_e = if !did_found <> -1 then add_loop_label !did_found new_e else new_e in
-			did_found := last_found;
-			in_switch := last_switch;
-			cur_num := last_num;
-
-			new_e
-		| TSwitch _ ->
-			let last_switch = !in_switch in
-			in_switch := true;
-				let new_e = Type.map_expr run e in
-			in_switch := last_switch;
-			new_e
-		| TBreak ->
-			if !in_switch then (
-				did_found := !cur_num;
-				add_loop_label !cur_num e
-			) else
-				e
-		| _ -> Type.map_expr run e
-	in
-	run e
-
-let fix_return_dynamic_from_void_function _ e =
-	let rec loop return_is_void e = match e.eexpr with
-		| TFunction fn ->
-			let is_void = ExtType.is_void (follow fn.tf_type) in
-			let body = loop is_void fn.tf_expr in
-			{ e with eexpr = TFunction { fn with tf_expr = body } }
-		| TReturn (Some return_expr) when return_is_void && t_dynamic == follow return_expr.etype ->
-			let return_pos = { e.epos with pmax = return_expr.epos.pmin - 1 } in
-			let exprs = [
-				loop return_is_void return_expr;
-				{ e with eexpr = TReturn None; epos = return_pos };
-			] in
-			{ e with
-				eexpr = TMeta (
-					(Meta.MergeBlock, [], null_pos),
-					mk (TBlock exprs) e.etype e.epos
-				);
-			}
-		| _ -> Type.map_expr (loop return_is_void) e
-	in
-	loop true e
-
-let check_abstract_as_value _ e =
-	let rec loop e =
-		match e.eexpr with
-		| TField ({ eexpr = TTypeExpr _ }, _) -> ()
-		| TTypeExpr(TClassDecl {cl_kind = KAbstractImpl a}) when not (Meta.has Meta.RuntimeValue a.a_meta) ->
-			raise_typing_error "Cannot use abstract as value" e.epos
-		| _ -> Type.iter loop e
-	in
-	loop e;
-	e
-
-(* PASS 1 end *)
-
 (* PASS 2 begin *)
 
 (* Applies exclude macro (which turns types into externs) *)
 
-let apply_macro_exclude com t = match t with
+let apply_macro_exclude t = match t with
 	| TClassDecl c when has_class_flag c CExcluded ->
 		add_class_flag c CExtern
 	| TEnumDecl e when has_enum_flag e EnExcluded ->
@@ -300,16 +39,16 @@ let apply_macro_exclude com t = match t with
 
 (* Removes extern and macro fields, also checks for Void fields *)
 
-let remove_extern_fields com t = match t with
+let remove_extern_fields scom t = match t with
 	| TClassDecl c ->
-		if not (Common.defined com Define.DocGen) then begin
+		if not (Define.defined scom.defines Define.DocGen) then begin
 			c.cl_ordered_fields <- List.filter (fun f ->
-				let b = is_removable_field com f in
+				let b = FilterContext.is_removable_field scom.is_macro_context f in
 				if b then c.cl_fields <- PMap.remove f.cf_name c.cl_fields;
 				not b
 			) c.cl_ordered_fields;
 			c.cl_ordered_statics <- List.filter (fun f ->
-				let b = is_removable_field com f in
+				let b = FilterContext.is_removable_field scom.is_macro_context f in
 				if b then c.cl_statics <- PMap.remove f.cf_name c.cl_statics;
 				not b
 			) c.cl_ordered_statics;
@@ -325,19 +64,19 @@ let remove_extern_fields com t = match t with
 let check_private_path com t = match t with
 	| TClassDecl c when c.cl_private ->
 		let rpath = (fst c.cl_module.m_path,"_" ^ snd c.cl_module.m_path) in
-		if com.module_lut#get_type_lut#mem rpath then raise_typing_error ("This private class name will clash with " ^ s_type_path rpath) c.cl_pos;
+		if com.Common.module_lut#get_type_lut#mem rpath then raise_typing_error ("This private class name will clash with " ^ s_type_path rpath) c.cl_pos;
 	| _ ->
 		()
 
 (* Adds the __rtti field if required *)
-let add_rtti com t =
+let add_rtti scom t =
 	let rec has_rtti c =
 		Meta.has Meta.Rtti c.cl_meta || match c.cl_super with None -> false | Some (csup,_) -> has_rtti csup
 	in
 	match t with
 	| TClassDecl c when has_rtti c && not (PMap.mem "__rtti" c.cl_statics) ->
-		let f = mk_field ~static:true "__rtti" com.basic.tstring c.cl_pos null_pos in
-		let str = Genxml.gen_type_string com t in
+		let f = mk_field ~static:true "__rtti" scom.basic.tstring c.cl_pos null_pos in
+		let str = Genxml.gen_type_string t in
 		f.cf_expr <- Some (mk (TConst (TString str)) f.cf_type c.cl_pos);
 		c.cl_ordered_statics <- f :: c.cl_ordered_statics;
 		c.cl_statics <- PMap.add f.cf_name f c.cl_statics;
@@ -345,12 +84,12 @@ let add_rtti com t =
 		()
 
 (* Adds the __meta__ field if required *)
-let add_meta_field com t = match t with
+let add_meta_field (com : Common.context) t = match t with
 	| TClassDecl c ->
 		(match Texpr.build_metadata com.basic t with
 		| None -> ()
 		| Some e ->
-			add_feature com "has_metadata";
+			Common.add_feature com "has_metadata";
 			let cf = mk_field ~static:true "__meta__" e.etype e.epos null_pos in
 			cf.cf_expr <- Some e;
 			let can_deal_with_interface_metadata () = match com.platform with
@@ -411,10 +150,10 @@ let commit_features com t =
 		Common.add_feature com k;
 	) m.m_extra.m_features
 
-let check_reserved_type_paths com t =
+let check_reserved_type_paths scom t =
 	let check path pos =
-		if List.mem path com.config.pf_reserved_type_paths then begin
-			com.warning WReservedTypePath [] ("Type path " ^ (s_type_path path) ^ " is reserved on this target") pos
+		if List.mem path scom.platform_config.pf_reserved_type_paths then begin
+			SafeCom.add_warning scom WReservedTypePath ("Type path " ^ (s_type_path path) ^ " is reserved on this target") pos
 		end
 	in
 	match t with
@@ -439,68 +178,88 @@ let iter_expressions fl mt =
 
 open FilterContext
 
-let destruction tctx ectx detail_times main locals =
-	let com = tctx.com in
-	with_timer detail_times "type 2" None (fun () ->
-		(* PASS 2: type filters pre-DCE *)
-		List.iter (fun t ->
-			FiltersCommon.remove_generic_base t;
-			apply_macro_exclude com t;
-			remove_extern_fields com t;
-			(* check @:remove metadata before DCE so it is ignored there (issue #2923) *)
-			check_remove_metadata t;
-		) com.types;
+let destruction_before_dce scom types =
+	let filters = [
+		(fun _ -> FiltersCommon.remove_generic_base);
+		(fun _ -> apply_macro_exclude);
+		(fun _ -> remove_extern_fields scom);
+		(* check @:remove metadata before DCE so it is ignored there (issue #2923) *)
+		(fun _ -> check_remove_metadata);
+	] in
+	SafeCom.run_type_filters_safe scom filters types
+
+let destruction_on_scom scom ectx rename_locals_config types =
+	let filters = [
+		SaveStacks.patch_constructors ectx;
+		(fun _ -> Native.apply_native_paths);
+		(fun _ -> add_rtti scom);
+		(match scom.platform with | Jvm -> (fun _ _ -> ()) | _ -> (fun scom mt -> AddFieldInits.add_field_inits scom.curclass.cl_path rename_locals_config scom mt));
+		(fun _ -> check_void_field);
+		(fun _ -> (match scom.platform with | Cpp -> promote_first_interface_to_super | _ -> (fun _ -> ())));
+		(fun _ -> (if scom.platform_config.pf_reserved_type_paths <> [] then check_reserved_type_paths scom else (fun _ -> ())));
+	] in
+	SafeCom.run_type_filters_safe scom filters types
+
+let destruction_on_com scom com types =
+	let filters = [
+		(fun _ -> check_private_path com);
+		(match com.platform with Hl -> (fun _ _ -> ()) | _ -> (fun _ -> add_meta_field com));
+		(fun _ -> commit_features com);
+	] in
+	(* These aren't actually safe. The logic works fine regardless, we just can't parallelize this at the moment. *)
+	SafeCom.run_type_filters_safe scom filters types
+
+let destruction (com : Common.context) scom ectx detail_times main rename_locals_config types =
+	with_timer scom.timer_ctx detail_times "type 2" None (fun () ->
+		SafeCom.run_with_scom com scom (fun () ->
+			destruction_before_dce scom types
+		)
 	);
-	enter_stage com CDceStart;
-	with_timer detail_times "dce" None (fun () ->
+
+	Common.enter_stage com CDceStart;
+	with_timer scom.timer_ctx detail_times "dce" None (fun () ->
 		(* DCE *)
-		let dce_mode = try Common.defined_value com Define.Dce with _ -> "no" in
+		let dce_mode = try Define.defined_value scom.defines Define.Dce with _ -> "no" in
 		let dce_mode = match dce_mode with
-			| "full" -> if Common.defined com Define.Interp then Dce.DceNo else DceFull
+			| "full" -> if Define.defined scom.defines Define.Interp then Dce.DceNo else DceFull
 			| "std" -> DceStd
 			| "no" -> DceNo
 			| _ -> failwith ("Unknown DCE mode " ^ dce_mode)
 		in
-		Dce.run com main dce_mode;
+		let std_paths = com.class_paths#get_std_paths in
+		let mscom = Option.map of_com (com.get_macros()) in
+		let types = Dce.run scom mscom main dce_mode std_paths types in
+		com.types <- types
 	);
-	enter_stage com CDceDone;
-	(* PASS 3: type filters post-DCE *)
-	List.iter
-		(run_expression_filters
-			~ignore_processed_status:true
-			tctx
-			detail_times
-			(* This has to run after DCE, or otherwise its condition always holds. *)
-			["insert_save_stacks",(fun tctx -> Exceptions.insert_save_stacks tctx ectx)]
+	Common.enter_stage com CDceDone;
+	let types = com.types in
+
+	(* This has to run after DCE, or otherwise its condition always holds. *)
+	begin match ectx with
+		| Some ectx when Common.has_feature com "haxe.NativeStackTrace.exceptionStack" ->
+			List.iter (
+				SafeCom.run_expression_filters_safe ~ignore_processed_status:true scom detail_times ["insert_save_stacks",SaveStacks.insert_save_stacks ectx]
+			) types
+		| _ ->
+			()
+	end;
+
+	with_timer scom.timer_ctx detail_times "type 3" None (fun () ->
+		SafeCom.run_with_scom com scom (fun () ->
+			destruction_on_scom scom ectx rename_locals_config types
+		)
+	);
+
+	with_timer scom.timer_ctx detail_times "type 4" None (fun () ->
+		SafeCom.run_with_scom com scom (fun () ->
+			destruction_on_com scom com types
 		)
-		com.types;
-	let type_filters = [
-		(fun tctx -> Exceptions.patch_constructors tctx ectx); (* TODO: I don't believe this should load_instance anything at this point... *)
-		(fun _ -> check_private_path com);
-		(fun _ -> Native.apply_native_paths);
-		(fun _ -> add_rtti com);
-		(match com.platform with | Jvm -> (fun _ _ -> ()) | _ -> (fun tctx mt -> AddFieldInits.add_field_inits tctx.c.curclass.cl_path locals com mt));
-		(match com.platform with Hl -> (fun _ _ -> ()) | _ -> (fun _ -> add_meta_field com));
-		(fun _ -> check_void_field);
-		(fun _ -> (match com.platform with | Cpp -> promote_first_interface_to_super | _ -> (fun _ -> ())));
-		(fun _ -> commit_features com);
-		(fun _ -> (if com.config.pf_reserved_type_paths <> [] then check_reserved_type_paths com else (fun _ -> ())));
-	] in
-	with_timer detail_times "type 3" None (fun () ->
-		List.iter (fun t ->
-			let tctx = match t with
-				| TClassDecl c ->
-					TyperManager.clone_for_class tctx c
-				| _ ->
-					tctx
-			in
-			List.iter (fun f -> f tctx t) type_filters
-		) com.types;
 	);
+
 	com.callbacks#run com.error_ext com.callbacks#get_after_filters;
-	enter_stage com CFilteringDone
+	Common.enter_stage com CFilteringDone
 
-let update_cache_dependencies ~close_monomorphs com t =
+let update_cache_dependencies ~close_monomorphs scom t =
 	let visited_anons = ref [] in
 	let rec check_t m t = match t with
 		| TInst(c,tl) ->
@@ -529,7 +288,7 @@ let update_cache_dependencies ~close_monomorphs com t =
 					check_t m t
 				| _ ->
 					(* Bind any still open monomorph that's part of a signature to Any now (issue #10653) *)
-					if close_monomorphs then Monomorph.do_bind r com.basic.tany;
+					if close_monomorphs then Monomorph.do_bind r scom.basic.tany;
 		end
 		| TLazy f ->
 			check_t m (lazy_type f)
@@ -551,10 +310,10 @@ let update_cache_dependencies ~close_monomorphs com t =
 			()
 
 (* Saves a class state so it can be restored later, e.g. after DCE or native path rewrite *)
-let save_class_state com t =
+let save_class_state compilation_step t =
 	(* Update m_processed here. This means that nothing should add a dependency afterwards because
 	   then the module is immediately considered uncached again *)
-	(t_infos t).mt_module.m_extra.m_processed <- com.compilation_step;
+	(t_infos t).mt_module.m_extra.m_processed <- compilation_step;
 	match t with
 	| TClassDecl c ->
 		let vars = ref [] in
@@ -646,9 +405,47 @@ let might_need_cf_unoptimized c cf =
 	| _ ->
 		has_class_field_flag cf CfGeneric
 
-let run tctx ectx main before_destruction =
-	let com = tctx.com in
-	let detail_times = (try int_of_string (Common.defined_value_safe com ~default:"0" Define.FilterTimes) with _ -> 0) in
+let run_safe_filters ectx (scom : SafeCom.t) new_types_array cv_wrapper_impl rename_locals_config pool =
+	let detail_times = Timer.level_from_define scom.defines Define.FilterTimes in
+
+	let filters_before_inlining = [
+		"handle_abstract_casts",AbstractCast.handle_abstract_casts;
+		"local_statics",LocalStatic.run;
+		"fix_return_dynamic_from_void_function",SafeFilters.fix_return_dynamic_from_void_function;
+		"check_local_vars_init",CheckVarInit.check_local_vars_init;
+		"check_abstract_as_value",SafeFilters.check_abstract_as_value;
+		"Tre",if Define.defined scom.defines Define.AnalyzerOptimize then Tre.run else (fun _ e -> e);
+	] in
+
+	let filters_before_analyzer = [
+		"reduce_expression",Optimizer.reduce_expression;
+		"inline_constructors",InlineConstructors.inline_constructors;
+		"Exceptions_filter",(fun _ -> Exceptions.filter ectx);
+		"captured_vars",(fun scom -> CapturedVars.captured_vars scom cv_wrapper_impl);
+	] in
+
+	let filters_after_analyzer = [
+		"sanitize",(fun scom e -> Sanitize.sanitize scom.SafeCom.platform_config e);
+		"add_final_return",(fun _ -> if scom.platform_config.pf_add_final_return then AddFinalReturn.add_final_return else (fun e -> e));
+		"RenameVars",(match scom.platform with
+			| Eval -> (fun _ e -> e)
+			| Jvm -> (fun _ e -> e)
+			| _ -> (fun scom e -> RenameVars.run scom.curclass.cl_path rename_locals_config e)
+		);
+		"mark_switch_break_loops",SafeFilters.mark_switch_break_loops;
+	] in
+
+	Parallel.ParallelArray.iter pool (SafeCom.run_expression_filters_safe scom detail_times filters_before_inlining) new_types_array;
+	Parallel.ParallelArray.iter pool (SafeCom.run_expression_filters_safe scom detail_times filters_before_analyzer) new_types_array;
+
+	(* enter_stage com CAnalyzerStart; *)
+	if scom.platform <> Cross then Analyzer.Run.run_on_types scom pool new_types_array;
+	(* enter_stage com CAnalyzerDone; *)
+	Parallel.ParallelArray.iter pool (SafeCom.run_expression_filters_safe scom detail_times filters_after_analyzer) new_types_array
+
+let run com ectx main before_destruction =
+	let scom = SafeCom.of_com com in
+	let detail_times = Timer.level_from_define com.defines Define.FilterTimes in
 	let new_types = List.filter (fun t ->
 		let cached = is_cached com t in
 		begin match t with
@@ -675,6 +472,8 @@ let run tctx ectx main before_destruction =
 		end;
 		not cached
 	) com.types in
+	let new_types_array = Array.of_list new_types in
+
 	(* IMPORTANT:
 	    There may be types in new_types which have already been post-processed, but then had their m_processed flag unset
 		because they received an additional dependency. This could happen in cases such as @:generic methods in #10635.
@@ -685,63 +484,30 @@ let run tctx ectx main before_destruction =
 		be aware of this.
 	*)
 	NullSafety.run com new_types;
-	(* PASS 1: general expression filters *)
-	let filters = [
-		"handle_abstract_casts",AbstractCast.handle_abstract_casts;
-	] in
-	List.iter (run_expression_filters tctx detail_times filters) new_types;
-	let filters = [
-		"local_statics",LocalStatic.run;
-		"fix_return_dynamic_from_void_function",fix_return_dynamic_from_void_function;
-		"check_local_vars_init",check_local_vars_init;
-		"check_abstract_as_value",check_abstract_as_value;
-		"Tre",if defined com Define.AnalyzerOptimize then Tre.run else (fun _ e -> e);
-		"reduce_expression",Optimizer.reduce_expression;
-		"inline_constructors",InlineConstructors.inline_constructors;
-		"Exceptions_filter",(fun _ -> Exceptions.filter ectx);
-		"captured_vars",(fun _ -> CapturedVars.captured_vars com);
-	] in
-	List.iter (run_expression_filters tctx detail_times filters) new_types;
-	(* PASS 1.5: pre-analyzer type filters *)
-	let filters =
-		match com.platform with
-		| Jvm ->
-			[
-				DefaultArguments.run com;
-			]
-		| _ ->
-			[]
-	in
-	with_timer detail_times "type 1" None (fun () ->
-		List.iter (fun f -> List.iter f new_types) filters;
+	let cv_wrapper_impl = CapturedVars.get_wrapper_implementation com in
+	let rename_locals_config = RenameVars.init scom.SafeCom.platform_config com.types in
+	Parallel.run_in_new_pool scom.timer_ctx (fun pool ->
+		SafeCom.run_with_scom com scom (fun () ->
+			run_safe_filters ectx scom new_types_array cv_wrapper_impl rename_locals_config pool
+		)
 	);
-	enter_stage com CAnalyzerStart;
-	if com.platform <> Cross then Analyzer.Run.run_on_types com new_types;
-	enter_stage com CAnalyzerDone;
-	let locals = RenameVars.init com in
-	let filters = [
-		"sanitize",(fun _ e -> Optimizer.sanitize com e);
-		"add_final_return",(fun _ -> if com.config.pf_add_final_return then add_final_return else (fun e -> e));
-		"RenameVars",(match com.platform with
-		| Eval -> (fun _ e -> e)
-		| Jvm -> (fun _ e -> e)
-		| _ -> (fun tctx e -> RenameVars.run tctx.c.curclass.cl_path locals e));
-		"mark_switch_break_loops",(fun _ -> mark_switch_break_loops);
-	] in
-	List.iter (run_expression_filters tctx detail_times filters) new_types;
-	with_timer detail_times "callbacks" None (fun () ->
+	with_timer com.timer_ctx detail_times "callbacks" None (fun () ->
 		com.callbacks#run com.error_ext com.callbacks#get_before_save;
 	);
-	enter_stage com CSaveStart;
-	with_timer detail_times "save state" None (fun () ->
+	Common.enter_stage com CSaveStart;
+	with_timer com.timer_ctx detail_times "save state" None (fun () ->
 		List.iter (fun mt ->
-			update_cache_dependencies ~close_monomorphs:true com mt;
-			save_class_state com mt
+			update_cache_dependencies ~close_monomorphs:true scom mt;
 		) new_types;
 	);
-	enter_stage com CSaveDone;
-	with_timer detail_times "callbacks" None (fun () ->
+	(* Note: We cannot have a thread pool up during the before/after_save callbacks because Eval's thread handling
+	   currently does not get along with it. This is why we need a separate pool for this operation. *)
+	Parallel.run_in_new_pool scom.timer_ctx (fun pool ->
+		Parallel.ParallelArray.iter pool (save_class_state com.compilation_step) new_types_array
+	);
+	Common.enter_stage com CSaveDone;
+	with_timer com.timer_ctx detail_times "callbacks" None (fun () ->
 		com.callbacks#run com.error_ext com.callbacks#get_after_save;
 	);
 	before_destruction();
-	destruction tctx ectx detail_times main locals
+	destruction com scom ectx detail_times main rename_locals_config com.types

+ 3 - 60
src/filters/filtersCommon.ml

@@ -21,24 +21,8 @@ open Type
 open Common
 open Typecore
 
-let rec is_removable_class c =
-	match c.cl_kind with
-	| KGeneric ->
-		(Meta.has Meta.Remove c.cl_meta ||
-		(match c.cl_super with
-			| Some (c,_) -> is_removable_class c
-			| _ -> false) ||
-		List.exists (fun tp ->
-			has_ctor_constraint tp.ttp_class || Meta.has Meta.Const tp.ttp_class.cl_meta
-		) c.cl_params)
-	| KTypeParameter _ ->
-		(* this shouldn't happen, have to investigate (see #4092) *)
-		true
-	| _ ->
-		false
-
 let remove_generic_base t = match t with
-	| TClassDecl c when is_removable_class c ->
+	| TClassDecl c when FilterContext.is_removable_class c ->
 		add_class_flag c CExtern;
 	| _ ->
 		()
@@ -53,51 +37,10 @@ let is_overridden cls field =
 	in
 	List.exists (fun d -> loop_inheritance d) cls.cl_descendants
 
-let run_expression_filters ?(ignore_processed_status=false) ctx detail_times filters t =
-	let com = ctx.com in
-	let run (ctx : typer) identifier e =
-		List.fold_left (fun e (filter_name,f) ->
-			(try
-				FilterContext.with_timer detail_times filter_name identifier (fun () -> f ctx e)
-			with Failure msg ->
-				com.error msg e.epos;
-				e)
-		) e filters
-	in
-	match t with
-	| TClassDecl c when is_removable_class c -> ()
-	| TClassDecl c ->
-		let ctx = TyperManager.clone_for_module ctx (TypeloadModule.make_curmod ctx.com ctx.g c.cl_module) in
-		let ctx = TyperManager.clone_for_class ctx c in
-		let rec process_field cf =
-			if ignore_processed_status || not (has_class_field_flag cf CfPostProcessed) then begin
-				let ctx = TyperManager.clone_for_field ctx cf cf.cf_params in
-				(match cf.cf_expr with
-				| Some e when not (is_removable_field com cf) ->
-					let identifier = Printf.sprintf "%s.%s" (s_type_path c.cl_path) cf.cf_name in
-					cf.cf_expr <- Some (rec_stack_loop AbstractCast.cast_stack cf (run ctx (Some identifier)) e);
-				| _ -> ());
-			end;
-			List.iter process_field cf.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);
-		(match TClass.get_cl_init c with
-		| None -> ()
-		| Some e ->
-			let identifier = Printf.sprintf "%s.__init__" (s_type_path c.cl_path) in
-			TClass.set_cl_init c (run ctx (Some identifier) e))
-	| TEnumDecl _ -> ()
-	| TTypeDecl _ -> ()
-	| TAbstractDecl _ -> ()
-
 let is_cached com t =
 	let m = (t_infos t).mt_module.m_extra in
 	m.m_processed <> 0 && m.m_processed < com.compilation_step
 
-let apply_filters_once ctx filters t =
+let apply_filters_once ctx scom filters t =
 	let detail_times = (try int_of_string (Common.defined_value_safe ctx.com ~default:"0" Define.FilterTimes) with _ -> 0) in
-	if not (is_cached ctx.com t) then run_expression_filters ctx detail_times filters t
+	if not (is_cached ctx.com t) then SafeCom.run_expression_filters_safe scom detail_times filters t

+ 19 - 19
src/filters/renameVars.ml

@@ -1,7 +1,7 @@
 open Globals
 open Type
-open Common
 open Ast
+open PlatformConfig
 
 type rename_init = {
 	mutable ri_scope : var_scope;
@@ -25,7 +25,7 @@ let reserve_init ri name =
 	Make all module-level names reserved.
 	No local variable will have a name matching a module-level declaration.
 *)
-let reserve_all_types ri com path_to_name =
+let reserve_all_types ri types path_to_name =
 	List.iter (fun mt ->
 		let tinfos = t_infos mt in
 		let native_name = try fst (Native.get_native_name tinfos.mt_meta) with Not_found -> path_to_name tinfos.mt_path in
@@ -43,14 +43,14 @@ let reserve_all_types ri com path_to_name =
 			) fl
 		| _ ->
 			reserve_init ri native_name
-	) com.types
+	) types
 
 (**
 	Initialize the context for local variables renaming
 *)
-let init com =
+let init config types =
 	let ri = {
-		ri_scope = com.config.pf_scoping.vs_scope;
+		ri_scope = config.pf_scoping.vs_scope;
 		ri_reserved = StringMap.empty;
 		ri_hoisting = false;
 		ri_no_shadowing = false;
@@ -72,35 +72,35 @@ let init com =
 		| ReserveNames names ->
 			List.iter (reserve_init ri) names
 		| ReserveAllTopLevelSymbols ->
-			reserve_all_types ri com (fun (pack,name) -> if pack = [] then name else List.hd pack)
+			reserve_all_types ri types (fun (pack,name) -> if pack = [] then name else List.hd pack)
 		| ReserveAllTypesFlat ->
-			reserve_all_types ri com Path.flat_path
+			reserve_all_types ri types Path.flat_path
 		| ReserveCurrentTopLevelSymbol -> ri.ri_reserve_current_top_level_symbol <- true
-	) com.config.pf_scoping.vs_flags;
+	) config.pf_scoping.vs_flags;
 	ri
 
 module Overlaps = struct
 	type t = {
 		mutable ov_vars : tvar list;
-		mutable ov_lut : (int,bool) Hashtbl.t;
+		mutable ov_lut : bool IntHashtbl.t;
 		mutable ov_name_cache : bool StringMap.t option;
 	}
 
 	let create () = {
 		ov_vars = [];
-		ov_lut = Hashtbl.create 0;
+		ov_lut = IntHashtbl.create 0;
 		ov_name_cache = None;
 	}
 
 	let copy ov = {
 		ov_vars = ov.ov_vars;
-		ov_lut = Hashtbl.copy ov.ov_lut;
+		ov_lut = IntHashtbl.copy ov.ov_lut;
 		ov_name_cache = ov.ov_name_cache;
 	}
 
 	let add v ov =
 		ov.ov_vars <- v :: ov.ov_vars;
-		Hashtbl.add ov.ov_lut v.v_id true;
+		IntHashtbl.add ov.ov_lut v.v_id true;
 		ov.ov_name_cache <- None
 
 	let get_cache ov = match ov.ov_name_cache with
@@ -118,11 +118,11 @@ module Overlaps = struct
 		List.iter f ov.ov_vars
 
 	let mem id ov =
-		Hashtbl.mem ov.ov_lut id
+		IntHashtbl.mem ov.ov_lut id
 
 	let reset ov =
 		ov.ov_vars <- [];
-		Hashtbl.clear ov.ov_lut;
+		IntHashtbl.clear ov.ov_lut;
 		ov.ov_name_cache <- None
 
 	let is_empty ov = match ov.ov_vars with
@@ -167,7 +167,7 @@ type rename_context = {
 	rc_scope : var_scope;
 	mutable rc_reserved : bool StringMap.t;
 	(** Scope a variable is declared in *)
-	rc_var_origins : (int,scope) Hashtbl.t;
+	rc_var_origins : scope IntHashtbl.t;
 }
 
 (**
@@ -216,7 +216,7 @@ let declare_var rc scope v =
 			end
 	in
 	scope.own_vars <- (v, overlaps) :: scope.own_vars;
-	Hashtbl.add rc.rc_var_origins v.v_id scope;
+	IntHashtbl.add rc.rc_var_origins v.v_id scope;
 	if scope.loop_count > 0 then
 		Overlaps.add v scope.loop_vars
 
@@ -255,7 +255,7 @@ let use_var rc scope v =
 	if not (will_be_reserved rc v) then
 		determine_overlaps rc scope v
 	else begin
-		let origin = Hashtbl.find rc.rc_var_origins v.v_id in
+		let origin = IntHashtbl.find rc.rc_var_origins v.v_id in
 		let rec loop scope =
 			if scope != origin then begin
 				if (rc.rc_no_shadowing || rc.rc_hoisting) then
@@ -355,7 +355,7 @@ let maybe_rename_var rc reserved (v,overlaps) =
 		v.v_name <- name
 	in
 	(* chop escape char for all local variables generated *)
-	if String.unsafe_get v.v_name 0 = String.unsafe_get Typecore.gen_local_prefix 0 then begin
+	if String.unsafe_get v.v_name 0 = String.unsafe_get gen_local_prefix 0 then begin
 		let name = String.sub v.v_name 1 (String.length v.v_name - 1) in
 		commit ("_g" ^ (Str.replace_first trailing_numbers "" name))
 	end;
@@ -391,7 +391,7 @@ let run cl_path ri e =
 		rc_no_catch_var_shadowing = ri.ri_no_catch_var_shadowing;
 		rc_switch_cases_no_blocks = ri.ri_switch_cases_no_blocks;
 		rc_reserved = ri.ri_reserved;
-		rc_var_origins = Hashtbl.create 0;
+		rc_var_origins = IntHashtbl.create 0;
 	} in
 	if ri.ri_reserve_current_top_level_symbol then begin
 		match cl_path with

+ 10 - 10
src/filters/addFieldInits.ml → src/filters/safe/addFieldInits.ml

@@ -1,9 +1,8 @@
 open Globals
-open Common
+open SafeCom
 open Type
 
-
-let add_field_inits cl_path locals com t =
+let add_field_inits cl_path locals scom t =
 	let apply c =
 		let ethis = mk (TConst TThis) (TInst (c,extract_param_types c.cl_params)) c.cl_pos in
 		(* TODO: we have to find a variable name which is not used in any of the functions *)
@@ -29,11 +28,11 @@ let add_field_inits cl_path locals com t =
 			let el = if !need_this then (mk (TVar((v, Some ethis))) ethis.etype ethis.epos) :: el else el in
 			let cf = match c.cl_constructor with
 			| None ->
-				let ct = TFun([],com.basic.tvoid) in
+				let ct = TFun([],scom.basic.tvoid) in
 				let ce = mk (TFunction {
 					tf_args = [];
-					tf_type = com.basic.tvoid;
-					tf_expr = mk (TBlock el) com.basic.tvoid c.cl_pos;
+					tf_type = scom.basic.tvoid;
+					tf_expr = mk (TBlock el) scom.basic.tvoid c.cl_pos;
 				}) ct c.cl_pos in
 				let ctor = mk_field "new" ct c.cl_pos null_pos in
 				ctor.cf_kind <- Method MethNormal;
@@ -42,20 +41,21 @@ let add_field_inits cl_path locals com t =
 				match cf.cf_expr with
 				| Some { eexpr = TFunction f } ->
 					let bl = match f.tf_expr with {eexpr = TBlock b } -> b | x -> [x] in
-					let ce = mk (TFunction {f with tf_expr = mk (TBlock (el @ bl)) com.basic.tvoid c.cl_pos }) cf.cf_type cf.cf_pos in
+					let ce = mk (TFunction {f with tf_expr = mk (TBlock (el @ bl)) scom.basic.tvoid c.cl_pos }) cf.cf_type cf.cf_pos in
 					{cf with cf_expr = Some ce };
 				| _ ->
 					die "" __LOC__
 			in
-			let config = AnalyzerConfig.get_field_config com c cf in
+			let config = AnalyzerConfig.get_field_config scom c cf in
 			remove_class_field_flag cf CfPostProcessed;
-			Analyzer.Run.run_on_field com config c cf;
+			Analyzer.Run.run_on_field scom config c cf;
 			add_class_field_flag cf CfPostProcessed;
 			(match cf.cf_expr with
 			| Some e ->
 				(* This seems a bit expensive, but hopefully constructor expressions aren't that massive. *)
 				let e = RenameVars.run cl_path locals e in
-				let e = Optimizer.sanitize com e in
+				let e = Sanitize.sanitize scom.platform_config e in
+				let e = if scom.platform_config.pf_add_final_return then AddFinalReturn.add_final_return e else e in
 				cf.cf_expr <- Some e
 			| _ ->
 				());

+ 39 - 0
src/filters/safe/addFinalReturn.ml

@@ -0,0 +1,39 @@
+open Type
+
+(* Adds final returns to functions as required by some platforms *)
+let rec add_final_return e =
+	let rec loop e t =
+		let def_return p =
+			let c = (match follow t with
+				| TAbstract ({ a_path = [],"Int" },_) -> TInt 0l
+				| TAbstract ({ a_path = [],"Float" },_) -> TFloat "0."
+				| TAbstract ({ a_path = [],"Bool" },_) -> TBool false
+				| _ -> TNull
+			) in
+			{ eexpr = TReturn (Some { eexpr = TConst c; epos = p; etype = t }); etype = t_dynamic; epos = p }
+		in
+		match e.eexpr with
+		| TBlock el ->
+			(match List.rev el with
+			| [] -> e
+			| elast :: el ->
+				match loop elast t with
+				| { eexpr = TBlock el2 } -> { e with eexpr = TBlock ((List.rev el) @ el2) }
+				| elast -> { e with eexpr = TBlock (List.rev (elast :: el)) })
+		| TReturn _ ->
+			e
+		| _ ->
+			{ e with eexpr = TBlock [e;def_return e.epos] }
+	in
+
+	let e = Type.map_expr add_final_return e in
+
+	match e.eexpr with
+		| TFunction f ->
+			let f = (match follow f.tf_type with
+				| TAbstract ({ a_path = [],"Void" },[]) -> f
+				| _ -> { f with tf_expr = loop f.tf_expr f.tf_type }
+			) in
+			{ e with eexpr = TFunction f }
+		| _ ->
+			e

+ 26 - 26
src/filters/capturedVars.ml → src/filters/safe/capturedVars.ml

@@ -17,32 +17,13 @@
 	Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  *)
 open Globals
+open SafeCom
 open Type
-open Common
 open LocalUsage
 
-(* BLOCK VARIABLES CAPTURE *)
-(*
-	For some platforms, it will simply mark the variables which are used in closures
-	using the v_capture flag so it can be processed in a more optimized
-
-	For Flash/JS platforms, it will ensure that variables used in loop sub-functions
-	have an unique scope. It transforms the following expression :
-
-	for( x in array )
-		funs.push(function() return x++);
-
-	Into the following :
-
-	for( _x in array ) {
-		var x = [_x];
-		funs.push(function(x) { function() return x[0]++; }(x));
-	}
-*)
-let captured_vars com e =
-	let t = com.basic in
-
-	let impl = match com.platform with
+let get_wrapper_implementation com =
+	let t = com.Common.basic in
+	match com.platform with
 	(* optimized version for Java - use native arrays *)
 	| Jvm ->
 		let cnativearray =
@@ -84,7 +65,26 @@ let captured_vars com e =
 			method mk_init av v pos =
 				mk (TVar (av,Some (mk (TArrayDecl [mk (TLocal v) v.v_type pos]) av.v_type pos))) t.tvoid pos
 		end
-	in
+
+(* BLOCK VARIABLES CAPTURE *)
+(*
+	For some platforms, it will simply mark the variables which are used in closures
+	using the v_capture flag so it can be processed in a more optimized
+
+	For Flash/JS platforms, it will ensure that variables used in loop sub-functions
+	have an unique scope. It transforms the following expression :
+
+	for( x in array )
+		funs.push(function() return x++);
+
+	Into the following :
+
+	for( _x in array ) {
+		var x = [_x];
+		funs.push(function(x) { function() return x[0]++; }(x));
+	}
+*)
+let captured_vars scom impl e =
 
 	let mk_var v used =
 		let v2 = alloc_var v.v_kind v.v_name (PMap.find v.v_id used) v.v_pos in
@@ -146,7 +146,7 @@ let captured_vars com e =
 				Create a new function scope to make sure that the captured loop variable
 				will not be overwritten in next loop iteration
 			*)
-			if com.config.pf_capture_policy = CPLoopVars then
+			if scom.platform_config.pf_capture_policy = CPLoopVars then
 				(* We don't want to duplicate any variable declarations, so let's make copies (issue #3902). *)
 				let new_vars = List.map (fun v -> v.v_id,alloc_var v.v_kind v.v_name v.v_type v.v_pos) vars in
 				let rec loop e = match e.eexpr with
@@ -273,7 +273,7 @@ let captured_vars com e =
 		!assigned
 	in
 	let captured = all_vars e in
-	match com.config.pf_capture_policy with
+	match scom.platform_config.pf_capture_policy with
 	| CPNone -> e
 	| CPWrapRef -> do_wrap captured e
 	| CPLoopVars -> out_loop e

+ 137 - 0
src/filters/safe/checkVarInit.ml

@@ -0,0 +1,137 @@
+open Globals
+open Type
+
+let check_local_vars_init scom e =
+	let intersect vl1 vl2 =
+		PMap.mapi (fun v t -> t && PMap.find v vl2) vl1
+	in
+	let join vars cvars =
+		List.iter (fun v -> vars := intersect !vars v) cvars
+	in
+	let restore vars old_vars declared =
+		(* restore variables declared in this block to their previous state *)
+		vars := List.fold_left (fun acc v ->
+			try	PMap.add v (PMap.find v old_vars) acc with Not_found -> PMap.remove v acc
+		) !vars declared;
+	in
+	let declared = ref [] in
+	let outside_vars = ref IntMap.empty in
+	(* Set variables which belong to current function *)
+	let set_all_vars vars =
+		vars := PMap.mapi (fun id is_set -> if IntMap.mem id !outside_vars then is_set else true) !vars
+	in
+	let rec loop vars e =
+		match e.eexpr with
+		| TLocal v ->
+			let init = (try PMap.find v.v_id !vars with Not_found -> true) in
+			if not init then begin
+				if IntMap.mem v.v_id !outside_vars then
+					if v.v_name = "this" then SafeCom.add_warning scom WVarInit "this might be used before assigning a value to it" e.epos
+					else SafeCom.add_warning scom WVarInit ("Local variable " ^ v.v_name ^ " might be used before being initialized") e.epos
+				else
+					if v.v_name = "this" then Error.raise_typing_error "Missing this = value" e.epos
+					else Error.raise_typing_error ("Local variable " ^ v.v_name ^ " used without being initialized") e.epos
+			end
+		| TVar (v,eo) ->
+			begin
+				match eo with
+				| None when (match v.v_kind with VInlinedConstructorVariable _ -> true | _ -> false) ->
+					()
+				| None ->
+					declared := v.v_id :: !declared;
+					vars := PMap.add v.v_id false !vars
+				| Some e ->
+					loop vars e
+			end
+		| TBlock el ->
+			let old = !declared in
+			let old_vars = !vars in
+			declared := [];
+			List.iter (loop vars) el;
+			restore vars old_vars (List.rev !declared);
+			declared := old;
+		| TBinop (OpAssign,{ eexpr = TLocal v },e) when PMap.mem v.v_id !vars ->
+			begin match (Texpr.skip e).eexpr with
+				| TFunction _ ->
+					(* We can be sure that the function doesn't execute immediately, so it's fine to
+					   consider the local initialized (issue #9919). *)
+					vars := PMap.add v.v_id true !vars;
+					loop vars e;
+				| _ ->
+					loop vars e;
+					vars := PMap.add v.v_id true !vars
+			end
+		| TIf (e1,e2,eo) ->
+			loop vars e1;
+			let vbase = !vars in
+			loop vars e2;
+			(match eo with
+			| None -> vars := vbase
+			(* ignore else false cases (they are added by the side-effect handler) *)
+			| Some {eexpr = TConst (TBool(false))} -> ()
+			| Some e ->
+				let v1 = !vars in
+				vars := vbase;
+				loop vars e;
+				vars := intersect !vars v1)
+		| TWhile (cond,e,flag) ->
+			(match flag with
+			| NormalWhile when (match cond.eexpr with TParenthesis {eexpr = TConst (TBool true)} -> false | _ -> true) ->
+				loop vars cond;
+				let old = !vars in
+				loop vars e;
+				vars := old;
+			| _ ->
+				loop vars e;
+				loop vars cond)
+		| TTry (e,catches) ->
+			let cvars = List.map (fun (v,e) ->
+				let old = !vars in
+				loop vars e;
+				let v = !vars in
+				vars := old;
+				v
+			) catches in
+			loop vars e;
+			join vars cvars;
+		| TSwitch ({switch_subject = e;switch_cases = cases;switch_default = def} as switch) ->
+			loop vars e;
+			let cvars = List.map (fun {case_patterns = ec;case_expr = e} ->
+				let old = !vars in
+				List.iter (loop vars) ec;
+				vars := old;
+				loop vars e;
+				let v = !vars in
+				vars := old;
+				v
+			) cases in
+			(match def with
+			| None when switch.switch_exhaustive ->
+				(match cvars with
+				| cv :: cvars ->
+					PMap.iter (fun i b -> if b then vars := PMap.add i b !vars) cv;
+					join vars cvars
+				| [] -> ())
+			| None -> ()
+			| Some e ->
+				loop vars e;
+				join vars cvars)
+		(* mark all reachable vars as initialized, since we don't exit the block  *)
+		| TBreak | TContinue | TReturn None ->
+			set_all_vars vars
+		| TThrow e | TReturn (Some e) ->
+			loop vars e;
+			set_all_vars vars
+		| TFunction tf ->
+			let old = !outside_vars in
+			(* Mark all known variables as "outside" so we can ignore their initialization state within the function.
+			   We cannot use `vars` directly because we still care about initializations the function might make.
+			*)
+			PMap.iter (fun i _ -> outside_vars := IntMap.add i true !outside_vars) !vars;
+			loop vars tf.tf_expr;
+			outside_vars := old;
+		| _ ->
+			Type.iter (loop vars) e
+	in
+	loop (ref PMap.empty) e;
+	e

+ 11 - 11
src/filters/localStatic.ml → src/filters/safe/localStatic.ml

@@ -1,16 +1,16 @@
+open Globals
 open Type
-open Typecore
 open Error
 
 type lscontext = {
-	ctx : typer;
-	lut : (int,tclass_field) Hashtbl.t;
+	scom : SafeCom.t;
+	lut : tclass_field IntHashtbl.t;
 	mutable added_fields : tclass_field list;
 }
 
 let promote_local_static lsctx run v eo =
-	let name = Printf.sprintf "%s_%s" lsctx.ctx.f.curfield.cf_name v.v_name in
-	let c = lsctx.ctx.c.curclass in
+	let name = Printf.sprintf "%s_%s" lsctx.scom.curfield.cf_name v.v_name in
+	let c = lsctx.scom.curclass in
 	begin try
 		let cf = PMap.find name c.cl_statics in
 		raise_typing_error_ext (make_error (Custom (Printf.sprintf "The expanded name of this local (%s) conflicts with another static field" name)) ~sub:[
@@ -75,19 +75,19 @@ let promote_local_static lsctx run v eo =
 		lsctx.added_fields <- cf :: lsctx.added_fields;
 		(* Add to lookup early so that the duplication check works. *)
 		c.cl_statics <- PMap.add cf.cf_name cf c.cl_statics;
-		Hashtbl.add lsctx.lut v.v_id cf
+		IntHashtbl.add lsctx.lut v.v_id cf
 	end
 
 let find_local_static lut v =
-	Hashtbl.find lut v.v_id
+	IntHashtbl.find lut v.v_id
 
-let run ctx e =
+let run scom e =
 	let lsctx = {
-		ctx = ctx;
-		lut = Hashtbl.create 0;
+		scom = scom;
+		lut = IntHashtbl.create 0;
 		added_fields = [];
 	} in
-	let c = ctx.c.curclass in
+	let c = scom.curclass in
 	let rec run e = match e.eexpr with
 		| TBlock el ->
 			let el = ExtList.List.filter_map (fun e -> match e.eexpr with

+ 82 - 0
src/filters/safe/safeFilters.ml

@@ -0,0 +1,82 @@
+open Globals
+open Type
+
+let fix_return_dynamic_from_void_function _ e =
+	let rec loop return_is_void e = match e.eexpr with
+		| TFunction fn ->
+			let is_void = ExtType.is_void (follow fn.tf_type) in
+			let body = loop is_void fn.tf_expr in
+			{ e with eexpr = TFunction { fn with tf_expr = body } }
+		| TReturn (Some return_expr) when return_is_void && t_dynamic == follow return_expr.etype ->
+			let return_pos = { e.epos with pmax = return_expr.epos.pmin - 1 } in
+			let exprs = [
+				loop return_is_void return_expr;
+				{ e with eexpr = TReturn None; epos = return_pos };
+			] in
+			{ e with
+				eexpr = TMeta (
+					(Meta.MergeBlock, [], null_pos),
+					mk (TBlock exprs) e.etype e.epos
+				);
+			}
+		| _ -> Type.map_expr (loop return_is_void) e
+	in
+	loop true e
+
+let check_abstract_as_value _ e =
+	let rec loop e =
+		match e.eexpr with
+		| TField ({ eexpr = TTypeExpr _ }, _) -> ()
+		| TTypeExpr(TClassDecl {cl_kind = KAbstractImpl a}) when not (Meta.has Meta.RuntimeValue a.a_meta) ->
+			Error.raise_typing_error "Cannot use abstract as value" e.epos
+		| _ -> Type.iter loop e
+	in
+	loop e;
+	e
+
+let mark_switch_break_loops _ e =
+	let add_loop_label n e =
+		{ e with eexpr = TMeta ((Meta.LoopLabel,[(EConst(Int(string_of_int n, None)),e.epos)],e.epos), e) }
+	in
+	let in_switch = ref false in
+	let did_found = ref (-1) in
+	let num = ref 0 in
+	let cur_num = ref 0 in
+	let rec run e =
+		match e.eexpr with
+		| TFunction _ ->
+			let old_num = !num in
+			num := 0;
+				let ret = Type.map_expr run e in
+			num := old_num;
+			ret
+		| TWhile _ ->
+			let last_switch = !in_switch in
+			let last_found = !did_found in
+			let last_num = !cur_num in
+			in_switch := false;
+			incr num;
+			cur_num := !num;
+			did_found := -1;
+				let new_e = Type.map_expr run e in (* assuming that no loop will be found in the condition *)
+				let new_e = if !did_found <> -1 then add_loop_label !did_found new_e else new_e in
+			did_found := last_found;
+			in_switch := last_switch;
+			cur_num := last_num;
+
+			new_e
+		| TSwitch _ ->
+			let last_switch = !in_switch in
+			in_switch := true;
+				let new_e = Type.map_expr run e in
+			in_switch := last_switch;
+			new_e
+		| TBreak ->
+			if !in_switch then (
+				did_found := !cur_num;
+				add_loop_label !cur_num e
+			) else
+				e
+		| _ -> Type.map_expr run e
+	in
+	run e

+ 198 - 0
src/filters/safe/sanitize.ml

@@ -0,0 +1,198 @@
+open Ast
+open Type
+
+(* ---------------------------------------------------------------------- *)
+(* SANITIZE *)
+
+(*
+	makes sure that when an AST get generated to source code, it will not
+	generate expressions that evaluate differently. It is then necessary to
+	add parenthesises around some binary expressions when the AST does not
+	correspond to the natural operand priority order for the platform
+*)
+
+(*
+	this is the standard C++ operator precedence, which is also used by both JS and PHP
+*)
+let standard_precedence op =
+	let left = true and right = false in
+	match op with
+	| OpIn -> 4, right
+	| OpMult | OpDiv | OpMod -> 5, left
+	| OpAdd | OpSub -> 6, left
+	| OpShl | OpShr | OpUShr -> 7, left
+	| OpLt | OpLte | OpGt | OpGte -> 8, left
+	| OpEq | OpNotEq -> 9, left
+	| OpAnd -> 10, left
+	| OpXor -> 11, left
+	| OpOr -> 12, left
+	| OpInterval -> 13, right (* haxe specific *)
+	| OpBoolAnd -> 14, left
+	| OpBoolOr -> 15, left
+	| OpArrow -> 16, left
+	| OpNullCoal -> 17, right
+	| OpAssignOp OpAssign -> 18, right (* mimics ?: *)
+	| OpAssign | OpAssignOp _ -> 19, right
+
+let rec need_parent e =
+	match e.eexpr with
+	| TConst _ | TLocal _ | TArray _ | TField _ | TEnumParameter _ | TEnumIndex _ | TParenthesis _
+	| TCall _ | TNew _ | TTypeExpr _ | TObjectDecl _ | TArrayDecl _ | TIdent _ -> false
+	| TCast (e,None) | TMeta(_,e) -> need_parent e
+	| TCast _ | TThrow _ | TReturn _ | TTry _ | TSwitch _ | TIf _ | TWhile _ | TBinop _ | TContinue | TBreak
+	| TBlock _ | TVar _ | TFunction _ | TUnop _ -> true
+
+let sanitize_expr config e =
+	let parent e =
+		match e.eexpr with
+		| TParenthesis _ -> e
+		| _ -> mk (TParenthesis e) e.etype e.epos
+	in
+	let block e =
+		match e.eexpr with
+		| TBlock _ -> e
+		| _ -> mk (TBlock [e]) e.etype e.epos
+	in
+	let complex e =
+		(* complex expressions are the one that once generated to source consists in several expressions  *)
+		match e.eexpr with
+		| TVar _	(* needs to be put into blocks *)
+		| TCall ({ eexpr = TIdent "__js__" },_) (* we never know *)
+			-> block e
+		| _ -> e
+	in
+	(* tells if the printed expresssion ends with an if without else *)
+	let rec has_if e =
+		match e.eexpr with
+		| TIf (_,_,None) -> true
+		| TWhile (_,e,NormalWhile) -> has_if e
+		| _ -> false
+	in
+	match e.eexpr with
+	| TConst TNull ->
+		if config.PlatformConfig.pf_static && not (is_nullable e.etype) then begin
+			let rec loop t = match follow t with
+				| TMono _ -> () (* in these cases the null will cast to default value *)
+				| TFun _ -> () (* this is a bit a particular case, maybe flash-specific actually *)
+				(* TODO: this should use get_underlying_type, but we do not have access to Codegen here.  *)
+				| TAbstract(a,tl) when not (Meta.has Meta.CoreType a.a_meta) -> loop (apply_params a.a_params tl a.a_this)
+				| _ ->
+					if config != Common.default_config then (* This is atrocious *)
+						Error.raise_typing_error ("On static platforms, null can't be used as basic type " ^ s_type (print_context()) e.etype) e.epos
+			in
+			loop e.etype
+		end;
+		e
+	| TBinop (op,e1,e2) ->
+		let swap op1 op2 =
+			let p1, left1 = standard_precedence op1 in
+			let p2, _ = standard_precedence op2 in
+			left1 && p1 <= p2
+		in
+		let rec loop ee left =
+			match ee.eexpr with
+			| TBinop (op2,_,_) -> if left then not (swap op2 op) else swap op op2
+			| TIf _ -> if left then not (swap (OpAssignOp OpAssign) op) else swap op (OpAssignOp OpAssign)
+			| TCast (e,None) | TMeta (_,e) -> loop e left
+			| TConst (TInt i) when not left ->
+				(match op with
+					| OpAdd | OpSub -> (Int32.to_int i) < 0
+					| _ -> false
+				)
+			| TConst (TFloat flt) when not left ->
+				(match op with
+					| OpAdd | OpSub -> String.get flt 0 = '-'
+					| _ -> false
+				)
+			| _ -> false
+		in
+		let e1 = if loop e1 true then parent e1 else e1 in
+		let e2 = if loop e2 false then parent e2 else e2 in
+		{ e with eexpr = TBinop (op,e1,e2) }
+	| TUnop (Not,Prefix,{ eexpr = (TUnop (Not,Prefix,e1)) | (TParenthesis { eexpr = TUnop (Not,Prefix,e1) }) })
+		when ExtType.is_bool (Abstract.follow_with_abstracts_without_null e1.etype) ->
+		e1
+	| TUnop (op,mode,e1) ->
+		let rec loop ee =
+			match ee.eexpr with
+			| TConst (TInt i) when op = Neg && (Int32.to_int i) < 0 -> parent e1
+			| TConst (TFloat flt) when op = Neg && String.get flt 0 = '-' -> parent e1
+			| TBinop _ | TIf _ | TUnop _ -> parent e1
+			| TCast (e,None) | TMeta (_, e) -> loop e
+			| _ -> e1
+		in
+		{ e with eexpr = TUnop (op,mode,loop e1)}
+	| TIf (e1,e2,eelse) ->
+		let e1 = parent e1 in
+		let e2 = (if (eelse <> None && has_if e2) || (match e2.eexpr with TIf _ -> true | _ -> false) then block e2 else complex e2) in
+		let eelse = (match eelse with None -> None | Some e -> Some (complex e)) in
+		{ e with eexpr = TIf (e1,e2,eelse) }
+	| TWhile (e1,e2,flag) ->
+		let e1 = parent e1 in
+		let e2 = complex e2 in
+		{ e with eexpr = TWhile (e1,e2,flag) }
+	| TFunction f ->
+		let f = (match f.tf_expr.eexpr with
+			| TBlock exprs ->
+				if ExtType.is_void (follow f.tf_type) then
+					match List.rev exprs with
+					| { eexpr = TReturn None } :: rest -> { f with tf_expr = { f.tf_expr with eexpr = TBlock (List.rev rest) } }
+					| _ -> f
+				else
+					f
+			| _ -> { f with tf_expr = block f.tf_expr }
+		) in
+		{ e with eexpr = TFunction f }
+	| TCall (e2,args) ->
+		if need_parent e2 then { e with eexpr = TCall(parent e2,args) } else e
+	| TEnumParameter (e2,ef,i) ->
+		if need_parent e2 then { e with eexpr = TEnumParameter(parent e2,ef,i) } else e
+	| TEnumIndex e2 ->
+		if need_parent e2 then { e with eexpr = TEnumIndex(parent e2) } else e
+	| TField (e2,f) ->
+		if need_parent e2 then { e with eexpr = TField(parent e2,f) } else e
+	| TArray (e1,e2) ->
+		if need_parent e1 then { e with eexpr = TArray(parent e1,e2) } else e
+	| TTry (e1,catches) ->
+		let e1 = block e1 in
+		let catches = List.map (fun (v,e) -> v, block e) catches in
+		{ e with eexpr = TTry (e1,catches) }
+	| TSwitch switch ->
+		let e1 = parent switch.switch_subject in
+		let cases = List.map (fun case -> {case with case_expr = complex case.case_expr}) switch.switch_cases in
+		let def = Option.map complex switch.switch_default in
+		let switch = { switch with
+			switch_subject = e1;
+			switch_cases = cases;
+			switch_default = def;
+		} in
+		{ e with eexpr = TSwitch switch }
+	| _ ->
+		e
+
+let reduce_expr com e =
+	match e.eexpr with
+	| TBlock l ->
+		(match List.rev l with
+		| [] -> e
+		| ec :: l ->
+			(* remove all no-ops : not-final constants in blocks *)
+			match List.filter (fun e -> match e.eexpr with
+				| TConst _
+				| TBlock []
+				| TObjectDecl [] ->
+					false
+				| _ ->
+					true
+			) l with
+			| [] -> ec
+			| l -> { e with eexpr = TBlock (List.rev (ec :: l)) })
+	| TParenthesis ec ->
+		{ ec with epos = e.epos }
+	| TTry (e,[]) ->
+		e
+	| _ ->
+		e
+
+let rec sanitize config e =
+	sanitize_expr config (reduce_expr config (Type.map_expr (sanitize config) e))

+ 14 - 14
src/filters/tre.ml

@@ -1,13 +1,13 @@
 open Type
-open Typecore
+open SafeCom
 open Globals
 
 let rec collect_new_args_values ctx args declarations values n =
 	match args with
 	| [] -> declarations, values
 	| arg :: rest ->
-		let v = gen_local ctx arg.etype arg.epos in
-		let decl = { eexpr = TVar (v, Some arg); etype = ctx.t.tvoid; epos = v.v_pos }
+		let v = alloc_var VGenerated "tmp" arg.etype arg.epos in
+		let decl = { eexpr = TVar (v, Some arg); etype = ctx.basic.tvoid; epos = v.v_pos }
 		and value = { arg with eexpr = TLocal v } in
 		collect_new_args_values ctx rest (decl :: declarations) (value :: values) (n + 1)
 
@@ -22,13 +22,13 @@ let rec assign_args vars exprs =
 
 let replacement_for_TReturn ctx fn args p =
 	let temps_rev, args_rev = collect_new_args_values ctx args [] [] 0
-	and continue = mk TContinue ctx.t.tvoid Globals.null_pos in
+	and continue = mk TContinue ctx.basic.tvoid Globals.null_pos in
 	{
-		etype = ctx.t.tvoid;
+		etype = ctx.basic.tvoid;
 		epos = p;
 		eexpr = TMeta ((Meta.TailRecursion, [], null_pos), {
 			eexpr = TBlock ((List.rev temps_rev) @ (assign_args fn.tf_args (List.rev args_rev)) @ [continue]);
-			etype = ctx.t.tvoid;
+			etype = ctx.basic.tvoid;
 			epos = p;
 		});
 	}
@@ -55,7 +55,7 @@ let rec redeclare_vars ctx vars declarations replace_list =
 		let decl =
 			{
 				eexpr = TVar (new_v, Some { eexpr = TLocal v; etype = v.v_type; epos = v.v_pos; });
-				etype = ctx.t.tvoid;
+				etype = ctx.basic.tvoid;
 				epos = v.v_pos;
 			}
 		in
@@ -78,7 +78,7 @@ let rec replace_vars replace_list in_tail_recursion e =
 
 let wrap_loop ctx args body =
 	let wrap e =
-		let cond = mk (TConst (TBool true)) ctx.t.tbool Globals.null_pos in
+		let cond = mk (TConst (TBool true)) ctx.basic.tbool Globals.null_pos in
 		{ e with eexpr = TWhile (cond, e, Ast.NormalWhile) }
 	in
 	match collect_captured_args args body with
@@ -154,7 +154,7 @@ let rec transform_function ctx is_recursive_call fn =
 		if !add_loop then
 			let body =
 				if ExtType.is_void (follow fn.tf_type) then
-					mk (TBlock [body; mk (TReturn None) ctx.t.tvoid null_pos]) ctx.t.tvoid null_pos
+					mk (TBlock [body; mk (TReturn None) ctx.basic.tvoid null_pos]) ctx.basic.tvoid null_pos
 				else
 					body
 			in
@@ -199,23 +199,23 @@ let rec has_tail_recursion is_recursive_call cancel_tre function_end e =
 		check_expr (has_tail_recursion is_recursive_call cancel_tre function_end) e
 
 let run ctx =
-	if Common.defined ctx.com Define.NoTre then
+	if Define.defined ctx.defines Define.NoTre then
 		(fun e -> e)
 	else
 		(fun e ->
 			match e.eexpr with
 			| TFunction fn ->
 				let is_tre_eligible =
-					match ctx.f.curfield.cf_kind with
+					match ctx.curfield.cf_kind with
 					| Method MethDynamic -> false
 					| Method MethInline -> true
 					| Method MethNormal ->
-						PMap.mem ctx.f.curfield.cf_name ctx.c.curclass.cl_statics
+						PMap.mem ctx.curfield.cf_name ctx.curclass.cl_statics
 					| _ ->
-						has_class_field_flag ctx.f.curfield CfFinal
+						has_class_field_flag ctx.curfield CfFinal
 					in
 				let is_recursive_call callee args =
-					is_tre_eligible && is_recursive_method_call ctx.c.curclass ctx.f.curfield callee args
+					is_tre_eligible && is_recursive_method_call ctx.curclass ctx.curfield callee args
 				in
 				if has_tail_recursion is_recursive_call false true fn.tf_expr then
 					(* print_endline ("TRE: " ^ ctx.f.curfield.cf_pos.pfile ^ ": " ^ ctx.f.curfield.cf_name); *)

+ 1 - 0
src/generators/cpp/cppAst.ml

@@ -225,6 +225,7 @@ and tcpp_class_variable = {
   tcv_type : t;
   tcv_default : texpr option;
 
+  tcv_has_getter : bool;
   tcv_is_stackonly : bool;
   tcv_is_gc_element : bool;
   tcv_is_reflective : bool;

+ 1 - 0
src/generators/cpp/cppRetyper.ml

@@ -1533,6 +1533,7 @@ let rec tcpp_class_from_tclass ctx ids slots class_def class_params =
     tcv_type = field.cf_type;
     tcv_default = None;
 
+    tcv_has_getter = (match field.cf_kind with | Var { v_read = AccCall } -> true | _ -> false);
     tcv_is_stackonly = has_meta Meta.StackOnly field.cf_meta;
     tcv_is_reflective = reflective class_def field;
     tcv_is_gc_element = cpp_type_of field.cf_type |> is_gc_element ctx;

+ 6 - 7
src/generators/cpp/gen/cppGenClassImplementation.ml

@@ -582,17 +582,16 @@ let generate_managed_class base_ctx tcpp_class =
       value
     in
 
-  let print_variable var_printer get_printer (var:tcpp_class_variable) acc =
+  let print_variable var_printer get_printer var acc =
     if var.tcv_is_reflective && not (is_abstract_impl class_def) then
       let variable = get_wrapper var.tcv_field var.tcv_name in
 
-      match var.tcv_field.cf_kind with
-      | Var { v_read = AccCall } ->
+      if var.tcv_has_getter then
         let prop_check = checkPropCall var.tcv_field in
         let getter     = Printf.sprintf "get_%s()" var.tcv_field.cf_name |> get_wrapper var.tcv_field in
 
         (var.tcv_field.cf_name, String.length var.tcv_field.cf_name, get_printer prop_check getter variable) :: acc
-      | _ ->
+      else
         (var.tcv_field.cf_name, String.length var.tcv_field.cf_name, var_printer variable) :: acc
     else
       acc
@@ -608,11 +607,11 @@ let generate_managed_class base_ctx tcpp_class =
       acc
   in
 
-  let print_property printer (var:tcpp_class_variable) acc =
-    if var.tcv_is_reflective && not (is_abstract_impl class_def) then
+  let print_property printer var acc =
+    if var.tcv_has_getter && var.tcv_is_reflective && not (is_abstract_impl class_def) then (
       let prop_check = checkPropCall var.tcv_field in
       let getter     = Printf.sprintf "get_%s()" var.tcv_field.cf_name |> get_wrapper var.tcv_field in
-      (var.tcv_field.cf_name, String.length var.tcv_field.cf_name, printer prop_check getter) :: acc
+      (var.tcv_field.cf_name, String.length var.tcv_field.cf_name, printer prop_check getter) :: acc)
     else
       acc
   in

+ 4 - 2
src/generators/gctx.ml

@@ -3,7 +3,8 @@ open Type
 open Warning
 
 type context_main = {
-	mutable main_class : path option;
+	mutable main_path : path option;
+	mutable main_file : string option;
 	mutable main_expr : texpr option;
 }
 
@@ -31,6 +32,7 @@ type t = {
 	native_libs : NativeLibraries.native_library_base list;
 	include_files : (string * string) list;
 	std : tclass; (* TODO: I would prefer to not have this here, have to check default_cast *)
+	timer_ctx : Timer.timer_context;
 }
 
 let defined com s =
@@ -108,7 +110,7 @@ let get_entry_point gctx =
 		in
 		let e = Option.get gctx.main.main_expr in (* must be present at this point *)
 		(snd path, c, e)
-	) gctx.main.main_class
+	) gctx.main.main_path
 
 let get_es_version defines =
 	try int_of_string (Define.defined_value defines Define.JsEs) with _ -> 0

+ 20 - 20
src/generators/gencpp.ml

@@ -343,7 +343,7 @@ let generate_source ctx =
          let acc_decls        = (Enum enum) :: acc.decls in
          let acc_boot_enums   = enum_def.e_path :: acc.boot_enums in
          let acc_exe_classes  = (enum_def.e_path, deps, cur) :: acc.exe_classes in
-         
+
          { acc with decls = acc_decls; boot_enums = acc_boot_enums; exe_classes = acc_exe_classes; ids = ids }
       | _ ->
          acc
@@ -429,30 +429,30 @@ let generate_source ctx =
      end;
    end;
 
-   let output_name = match  common_ctx.main.main_class with
+   let output_name = match  common_ctx.main.main_path with
    | Some path -> (snd path)
    | _ -> "output" in
 
    write_build_data common_ctx (common_ctx.file ^ "/Build.xml") srcctx.exe_classes !main_deps (srcctx.boot_enums@ srcctx.boot_classes) srcctx.build_xml srcctx.extern_src output_name;
    write_build_options common_ctx (common_ctx.file ^ "/Options.txt") common_ctx.defines.Define.values;
    if ( not (Gctx.defined common_ctx Define.NoCompilation) ) then begin
-      let t = Timer.timer ["generate";"cpp";"native compilation"] in
-      let old_dir = Sys.getcwd() in
-      Sys.chdir common_ctx.file;
-      let cmd = ref ["run"; "hxcpp"; "Build.xml"; "haxe"] in
-	  if (common_ctx.debug) then cmd := !cmd @ ["-Ddebug"];
-      PMap.iter ( fun name value -> match name with
-         | "true" | "sys" | "dce" | "cpp" | "debug" -> ();
-         | _ -> cmd := !cmd @ [Printf.sprintf "-D%s=\"%s\"" name (escape_command value)];
-      ) common_ctx.defines.values;
-      common_ctx.class_paths#iter (fun path ->
-		let path = path#path in
-		cmd := !cmd @ [Printf.sprintf "-I%s" (escape_command path)]
-	  );
-      common_ctx.print ("haxelib " ^ (String.concat " " !cmd) ^ "\n");
-      if common_ctx.run_command_args "haxelib" !cmd <> 0 then failwith "Build failed";
-      Sys.chdir old_dir;
-      t()
+      Timer.time common_ctx.timer_ctx ["generate";"cpp";"native compilation"] (fun () ->
+		let old_dir = Sys.getcwd() in
+		Sys.chdir common_ctx.file;
+		let cmd = ref ["run"; "hxcpp"; "Build.xml"; "haxe"] in
+		if (common_ctx.debug) then cmd := !cmd @ ["-Ddebug"];
+		PMap.iter ( fun name value -> match name with
+			| "true" | "sys" | "dce" | "cpp" | "debug" -> ();
+			| _ -> cmd := !cmd @ [Printf.sprintf "-D%s=\"%s\"" name (escape_command value)];
+		) common_ctx.defines.values;
+		common_ctx.class_paths#iter (fun path ->
+			let path = path#path in
+			cmd := !cmd @ [Printf.sprintf "-I%s" (escape_command path)]
+		);
+		common_ctx.print ("haxelib " ^ (String.concat " " !cmd) ^ "\n");
+		if common_ctx.run_command_args "haxelib" !cmd <> 0 then failwith "Build failed";
+		Sys.chdir old_dir;
+	  ) ()
    end
 
 let generate common_ctx =
@@ -462,7 +462,7 @@ let generate common_ctx =
    if (Gctx.defined common_ctx Define.Cppia) then begin
       let ctx = new_context common_ctx debug_level (ref PMap.empty) StringMap.empty super_deps constructor_deps in
       CppCppia.generate_cppia ctx
-   end else begin   
+   end else begin
       let ctx = new_context common_ctx debug_level (ref PMap.empty) (create_member_types common_ctx) super_deps constructor_deps in
       generate_source ctx
    end

+ 95 - 43
src/generators/genhl.ml

@@ -86,6 +86,7 @@ type constval =
 
 type context = {
 	com : Gctx.t;
+	num_domains : int;
 	cglobals : (string, ttype) lookup;
 	cstrings : (string, string) lookup;
 	cbytes : (bytes, bytes) lookup;
@@ -95,11 +96,11 @@ type context = {
 	cfids : (string * path, unit) lookup;
 	cfunctions : fundecl DynArray.t;
 	cconstants : (constval, (global * int array)) lookup;
+	hl_ver : string;
 	optimize : bool;
 	w_null_compare : bool;
 	overrides : (string * path, bool) Hashtbl.t;
 	defined_funs : (int,unit) Hashtbl.t;
-	mutable dump_out : (unit IO.output) option;
 	mutable cached_types : (string list, ttype) PMap.t;
 	mutable m : method_context;
 	mutable anons_cache : (tanon, ttype) PMap.t;
@@ -483,16 +484,11 @@ let rec to_type ?tref ctx t =
 				(fun tref -> to_type ~tref ctx (Abstract.get_underlying_type a pl))
 
 and resolve_class ctx c pl statics =
-	let not_supported() =
-		failwith ("Extern type not supported : " ^ s_type (print_context()) (TInst (c,pl)))
-	in
 	match c.cl_path, pl with
 	| ([],"Array"), [t] ->
 		if statics then ctx.array_impl.abase else array_class ctx (to_type ctx t)
 	| ([],"Array"), [] ->
 		die "" __LOC__
-	| _, _ when (has_class_flag c CExtern) ->
-		not_supported()
 	| _ ->
 		c
 
@@ -640,7 +636,7 @@ and class_type ?(tref=None) ctx c pl statics =
 			) :: ctx.ct_delayed;
 			fid
 		in
-		List.iter (fun f ->
+		if not (has_class_flag c CExtern) then List.iter (fun f ->
 			if is_extern_field f || (statics && f.cf_name = "__meta__") then () else
 			let fid = (match f.cf_kind with
 			| Method m when m <> MethDynamic && not statics ->
@@ -763,7 +759,50 @@ and enum_class ctx e =
 		} in
 		let t = HObj p in
 		ctx.cached_types <- PMap.add key_path t ctx.cached_types;
-		p.psuper <- Some (match class_type ctx ctx.base_enum [] false with HObj o -> o | _ -> die "" __LOC__);
+		let psuper = (match class_type ctx ctx.base_enum [] false with HObj o -> o | _ -> die "" __LOC__) in
+		let start_field = psuper.pnfields in
+		let fa = DynArray.create() in
+		let add_field name t =
+			let fid = start_field + DynArray.length fa in
+			let str = alloc_string ctx name in
+			DynArray.add fa (name, str, t);
+			p.pindex <- PMap.add name (fid, t) p.pindex;
+			fid
+		in
+			PMap.iter (fun _ ef -> 
+			(match follow ef.ef_type with
+				| TEnum _ -> ignore(add_field ef.ef_name (to_type ctx ef.ef_type))
+				| TFun (args, ret) ->
+					let fid = add_field ef.ef_name (to_type ctx ef.ef_type) in
+					let eid = alloc_eid ctx e ef in
+					let fargs = List.map (fun (_, _, t) -> to_type ctx t) args in
+					let tret = to_type ctx ret in
+					let old = ctx.m in
+					let ft = to_type ctx ef.ef_type in
+					ctx.m <- method_context eid ft null_capture false;
+					let arg_regs = List.map (fun t -> alloc_fresh ctx t) fargs in
+					let ret_reg = alloc_fresh ctx tret in
+					op ctx (OMakeEnum (ret_reg, ef.ef_index, arg_regs));
+					op ctx (ORet ret_reg);
+					let hlf = {
+						fpath = "", "";
+						findex = eid;
+						ftype = HFun (fargs, tret);
+						regs = DynArray.to_array ctx.m.mregs.arr;
+						code = DynArray.to_array ctx.m.mops;
+						debug = make_debug ctx ctx.m.mdebug;
+						assigns = Array.of_list (List.rev ctx.m.massign);
+						need_opt = false;
+					} in
+					ctx.m <- old;
+					Hashtbl.add ctx.defined_funs eid ();
+					DynArray.add ctx.cfunctions hlf;
+					p.pbindings <- (fid, eid) :: p.pbindings
+				| t -> die "" __LOC__);
+		) e.e_constrs;
+		p.pnfields <- DynArray.length fa;
+		p.pfields <- DynArray.to_array fa;
+		p.psuper <- Some psuper;
 		t
 
 and alloc_fun_path ctx path name =
@@ -790,13 +829,13 @@ and class_global ?(resolve=true) ctx c =
 	let t = class_type ctx c [] static in
 	alloc_global ctx ("$" ^ s_type_path c.cl_path) t, t
 
-let resolve_class_global ctx cpath =
+and resolve_class_global ctx cpath =
 	lookup ctx.cglobals ("$" ^ cpath) (fun() -> die "" __LOC__)
 
-let resolve_type ctx path =
+and resolve_type ctx path =
 	PMap.find path ctx.cached_types
 
-let alloc_std ctx name args ret =
+and alloc_std ctx name args ret =
 	let lib = "std" in
 	(* different from :hlNative to prevent mismatch *)
 	let nid = lookup ctx.cnatives ("$" ^ name ^ "@" ^ lib, -1) (fun() ->
@@ -807,12 +846,12 @@ let alloc_std ctx name args ret =
 	let _,_,_,fid = DynArray.get ctx.cnatives.arr nid in
 	fid
 
-let alloc_fresh ctx t =
+and alloc_fresh ctx t =
 	let rid = DynArray.length ctx.m.mregs.arr in
 	DynArray.add ctx.m.mregs.arr t;
 	rid
 
-let alloc_tmp ctx t =
+and alloc_tmp ctx t =
 	if not ctx.optimize then alloc_fresh ctx t else
 	let a = try PMap.find t ctx.m.mallocs with Not_found ->
 		let a = {
@@ -830,13 +869,13 @@ let alloc_tmp ctx t =
 	| r :: _ ->
 		r
 
-let current_pos ctx =
+and current_pos ctx =
 	DynArray.length ctx.m.mops
 
-let rtype ctx r =
+and rtype ctx r =
 	DynArray.get ctx.m.mregs.arr r
 
-let hold ctx r =
+and hold ctx r =
 	if not ctx.optimize then () else
 	let t = rtype ctx r in
 	let a = PMap.find t ctx.m.mallocs in
@@ -849,7 +888,7 @@ let hold ctx r =
 	a.a_all <- loop a.a_all;
 	a.a_hold <- r :: a.a_hold
 
-let free ctx r =
+and free ctx r =
 	if not ctx.optimize then () else
 	let t = rtype ctx r in
 	let a = PMap.find t ctx.m.mallocs in
@@ -872,10 +911,10 @@ let free ctx r =
 	in
 	if !last then a.a_all <- loop a.a_all
 
-let decl_var ctx v =
+and decl_var ctx v =
 	ctx.m.mdeclared <- v.v_id :: ctx.m.mdeclared
 
-let alloc_var ctx v new_var =
+and alloc_var ctx v new_var =
 	if new_var then decl_var ctx v;
 	try
 		Hashtbl.find ctx.m.mvars v.v_id
@@ -886,11 +925,11 @@ let alloc_var ctx v new_var =
 		r
 
 
-let push_op ctx o =
+and push_op ctx o =
 	DynArray.add ctx.m.mdebug ctx.m.mcurpos;
 	DynArray.add ctx.m.mops o
 
-let op ctx o =
+and op ctx o =
 	match o with
 	| OMov (a,b) when a = b ->
 		()
@@ -1086,11 +1125,11 @@ let rec eval_to ctx e (t:ttype) =
 		let r = alloc_tmp ctx t in
 		op ctx (OFloat (r,alloc_float ctx (Int32.to_float i)));
 		r
-	| TConst (TInt i), HF32 ->
+	| TConst (TInt i), HF32 when ctx.hl_ver >= "1.15" ->
 		let r = alloc_tmp ctx t in
 		op ctx (OFloat (r, alloc_float ctx (Int32.to_float i)));
 		r
-	| TConst (TFloat f), HF32 ->
+	| TConst (TFloat f), HF32 when ctx.hl_ver >= "1.15" ->
 		let r = alloc_tmp ctx t in
 		op ctx (OFloat (r, alloc_float ctx (float_of_string f)));
 		r
@@ -2367,7 +2406,7 @@ and eval_expr ctx e =
 		| _ -> unsafe_cast_to ctx r to_t e.epos)
 	| TObjectDecl fl ->
 		(match to_type ctx e.etype with
-		| HVirtual vp as t when Array.length vp.vfields = List.length fl && not (List.exists (fun ((s,_,_),e) -> s = "toString" && is_to_string e.etype) fl)  ->
+		| HVirtual vp as t when Array.length vp.vfields = List.length fl && not (List.exists (fun ((s,_,_),e) -> (try ignore(PMap.find s vp.vindex); false with Not_found -> true) || (s = "toString" && is_to_string e.etype)) fl) ->
 			let r = alloc_tmp ctx t in
 			op ctx (ONew r);
 			hold ctx r;
@@ -3261,6 +3300,7 @@ and gen_method_wrapper ctx rt t p =
 			code = DynArray.to_array ctx.m.mops;
 			debug = make_debug ctx ctx.m.mdebug;
 			assigns = Array.of_list (List.rev ctx.m.massign);
+			need_opt = false;
 		} in
 		ctx.m <- old;
 		DynArray.add ctx.cfunctions f;
@@ -3427,18 +3467,11 @@ and make_fun ?gen_content ctx name fidx f cthis cparent =
 		code = DynArray.to_array ctx.m.mops;
 		debug = make_debug ctx ctx.m.mdebug;
 		assigns = Array.of_list (List.sort (fun (_,p1) (_,p2) -> p1 - p2) (List.rev ctx.m.massign));
+		need_opt = (gen_content = None || name <> ("",""));
 	} in
 	ctx.m <- old;
 	Hashtbl.add ctx.defined_funs fidx ();
-	let f = if ctx.optimize && (gen_content = None || name <> ("","")) then begin
-		let t = Timer.timer ["generate";"hl";"opt"] in
-		let f = Hlopt.optimize ctx.dump_out (DynArray.get ctx.cstrings.arr) hlf f in
-		t();
-		f
-	end else
-		hlf
-	in
-	DynArray.add ctx.cfunctions f;
+	DynArray.add ctx.cfunctions hlf;
 	capt
 
 let generate_static ctx c f =
@@ -3461,8 +3494,7 @@ let generate_static ctx c f =
 			| (Meta.HlNative,[(EConst(String(lib,_)),_)] ,_ ) :: _ ->
 				add_native lib f.cf_name
 			| (Meta.HlNative,[(EConst(Float(ver,_)),_)] ,_ ) :: _ ->
-				let cur_ver = (try Gctx.defined_value ctx.com Define.HlVer with Not_found -> "") in
-				if cur_ver < ver then
+				if ctx.hl_ver < ver then
 					let gen_content() =
 						op ctx (OThrow (make_string ctx ("Requires compiling with -D hl-ver=" ^ ver ^ ".0 or higher") null_pos));
 					in
@@ -3693,8 +3725,10 @@ let generate_static_init ctx types main =
 				let rt = alloc_tmp ctx HType in
 				op ctx (OType (rt, t));
 				let r = alloc_tmp ctx (class_type ctx ctx.base_enum [] false) in
+				let etr = alloc_tmp ctx et in
 				op ctx (OCall2 (r, alloc_fun_path ctx ([],"Type") "initEnum", ret, rt));
 				free ctx ret;
+				op ctx (OSafeCast (etr, r));
 
 				let index name =
 					match et with
@@ -3718,6 +3752,7 @@ let generate_static_init ctx types main =
 						op ctx (OGetArray (rd,avalues, reg_int ctx f.ef_index));
 						op ctx (OSafeCast (r, rd));
 						op ctx (OSetGlobal (g,r));
+						op ctx (OSetField (etr, index f.ef_name ,r));
 				) e.e_names;
 
 				(match Texpr.build_metadata ctx.com.basic (TEnumDecl e) with
@@ -4105,7 +4140,7 @@ let write_code ch code debug =
 
 (* --------------------------------------------------------------------------------------------------------------------- *)
 
-let create_context com dump =
+let create_context com =
 	let get_type name =
 		try
 			List.find (fun t -> (t_infos t).mt_path = (["hl"],name)) com.types
@@ -4126,9 +4161,10 @@ let create_context com dump =
 	in
 	let ctx = {
 		com = com;
+		hl_ver = Gctx.defined_value_safe ~default:"" com Define.HlVer;
 		optimize = not (Gctx.raw_defined com "hl_no_opt");
 		w_null_compare = Gctx.raw_defined com "hl_w_null_compare";
-		dump_out = if dump then Some (IO.output_channel (open_out_bin "dump/hlopt.txt")) else None;
+		num_domains = Domain.recommended_domain_count ();
 		m = method_context 0 HVoid null_capture false;
 		cints = new_lookup();
 		cstrings = new_lookup();
@@ -4258,12 +4294,28 @@ let generate com =
 		close_out ch;
 	end else
 
-	let ctx = create_context com dump in
+	let ctx = create_context com in
 	add_types ctx com.types;
+
 	let code = build_code ctx com.types com.main.main_expr in
 	Array.sort (fun (lib1,_,_,_) (lib2,_,_,_) -> lib1 - lib2) code.natives;
+
+	if ctx.optimize then begin
+		let t = Timer.start_timer com.timer_ctx ["generate";"hl";"opt"] in
+		let dump_out = if dump then Some (IO.output_channel (open_out_bin "dump/hlopt.txt")) else None in
+		Parallel.run_parallel_for ctx.num_domains ~chunk_size:16 (DynArray.length ctx.cfunctions) (fun idx ->
+			let f = DynArray.get ctx.cfunctions idx in
+			if f.need_opt then begin
+				let f, dumpstr = Hlopt.optimize dump (Array.get code.strings) f "todosign" in
+				(match dump_out with None -> () | Some ch -> IO.nwrite_string ch dumpstr);
+				code.functions.(idx) <- f;
+			end;
+		);
+		(match dump_out with None -> () | Some ch -> IO.close_out ch);
+		t();
+	end;
+
 	if dump then begin
-		(match ctx.dump_out with None -> () | Some ch -> IO.close_out ch);
 		let ch = open_out_bin "dump/hlcode.txt" in
 		Hlcode.dump (fun s -> output_string ch (s ^ "\n")) code;
 		close_out ch;
@@ -4283,7 +4335,7 @@ let generate com =
 		check ctx;
 		Hlinterp.check com.error code;
 	end;
-	let t = Timer.timer ["generate";"hl";"write"] in
+	let t = Timer.start_timer com.timer_ctx ["generate";"hl";"write"] in
 
 	let escape_command s =
 		let b = Buffer.create 0 in
@@ -4300,8 +4352,8 @@ let generate com =
 			let version_revision = com.version.revision in
 			Gctx.define_value com Define.SourceHeader (Printf.sprintf "Generated by HLC %d.%d.%d (HL v%d)" version_major version_minor version_revision code.version);
 		end;
-		Hl2c.write_c com com.file code gnames;
-		let t = Timer.timer ["nativecompile";"hl"] in
+		Hl2c.write_c com com.file code gnames ctx.num_domains;
+		let t = Timer.start_timer com.timer_ctx ["nativecompile";"hl"] in
 		if not (Gctx.defined com Define.NoCompilation) && com.run_command_args "haxelib" ["run";"hashlink";"build";escape_command com.file] <> 0 then failwith "Build failed";
 		t();
 	end else begin
@@ -4321,7 +4373,7 @@ let generate com =
 	end;
 	if Gctx.defined com Define.Interp then
 		try
-			let t = Timer.timer ["generate";"hl";"interp"] in
+			let t = Timer.start_timer com.timer_ctx ["generate";"hl";"interp"] in
 			let ctx = Hlinterp.create true in
 			Hlinterp.add_code ctx code;
 			t();

+ 162 - 87
src/generators/genjvm.ml

@@ -51,6 +51,11 @@ let get_construction_mode c cf =
 	else ConstructInit
 
 (* Haxe *)
+type mutexes = {
+	write_class : Mutex.t;
+	unify : Mutex.t;
+	closure_lookup : Mutex.t;
+}
 
 type generation_context = {
 	gctx : Gctx.t;
@@ -59,19 +64,18 @@ type generation_context = {
 	entry_point : (tclass * texpr) option;
 	t_exception : Type.t;
 	t_throwable : Type.t;
-	anon_identification : jsignature tanon_identification;
-	mutable functional_interfaces : (tclass * tclass_field * JvmFunctions.JavaFunctionalInterface.t) list;
-	mutable preprocessor : jsignature preprocessor;
+	anon_identification : jsignature tanon_identification; (* guards itself *)
+	mutable (* final after preprocessing *) functional_interfaces : (tclass * tclass_field * JvmFunctions.JavaFunctionalInterface.t) list;
+	mutable (* final after preprocessing *) preprocessor : jsignature preprocessor;
 	default_export_config : export_config;
-	typed_functions : JvmFunctions.typed_functions;
-	known_typed_functions : (path,unit) Hashtbl.t;
-	closure_paths : (path * string * jsignature,path) Hashtbl.t;
-	enum_paths : (path,unit) Hashtbl.t;
+	typed_functions : JvmFunctions.typed_functions; (* guards itself *)
+	closure_paths : (path * string * jsignature,path) Hashtbl.t; (* guarded by mutexes.closure_lookup *)
+	enum_paths : (path,unit) Hashtbl.t; (* final after preprocessing *)
 	detail_times : bool;
-	mutable timer : Timer.timer;
-	mutable typedef_interfaces : jsignature typedef_interfaces;
+	mutable (* final after preprocessing *) typedef_interfaces : jsignature typedef_interfaces;
 	jar_compression_level : int;
 	dynamic_level : int;
+	mutexes : mutexes;
 }
 
 type ret =
@@ -100,10 +104,8 @@ let run_timed gctx detail name f =
 	if detail && not gctx.detail_times then
 		f()
 	else begin
-		let sub = gctx.timer#nest name in
-		let old = gctx.timer in
-		gctx.timer <- sub;
-		sub#run_finally f (fun () -> gctx.timer <- old)
+		let timer_ctx = gctx.gctx.timer_ctx in
+		Timer.time timer_ctx (timer_ctx.current.id @ [name]) f ()
 	end
 
 class file_output
@@ -194,7 +196,6 @@ let rec jsignature_of_type gctx stack t =
 	| TInst({cl_path = ["_Enum"],"Enum_Impl_"},_) -> java_class_sig
 	| TInst(c,tl) -> TObject(c.cl_path,List.map jtype_argument_of_type tl)
 	| TEnum(en,tl) ->
-		Hashtbl.replace gctx.enum_paths en.e_path ();
 		TObject(en.e_path,List.map jtype_argument_of_type tl)
 	| TFun(tl,tr) -> method_sig (List.map (fun (_,o,t) ->
 		let jsig = jsignature_of_type t in
@@ -352,11 +353,12 @@ let write_class gctx path jc =
 		| (sl,s) -> String.concat "/" sl ^ "/" ^ s
 	in
 	let path = dir ^ ".class" in
-	let t = Timer.timer ["jvm";"write"] in
-	let ch = IO.output_bytes() in
-	JvmWriter.write_jvm_class ch jc;
-	gctx.out#add_entry (Bytes.unsafe_to_string (IO.close_out ch)) path;
-	t()
+	Timer.time gctx.gctx.timer_ctx ["generate";"jvm";"write"] (fun () ->
+		let ch = IO.output_bytes() in
+		JvmWriter.write_jvm_class ch jc;
+		let bytes = Bytes.unsafe_to_string (IO.close_out ch) in
+		Mutex.protect gctx.mutexes.write_class (fun () -> gctx.out#add_entry bytes path);
+	) ()
 
 let is_const_int_pattern case =
 	List.for_all (fun e -> match e.eexpr with
@@ -426,31 +428,32 @@ let associate_functional_interfaces gctx f t =
 			let map t = apply_params c.cl_params c_monos t in
 			let cf_monos = Monomorph.spawn_constrained_monos map cf.cf_params in
 			try
-				Type.unify_custom native_unification_context t (apply_params cf.cf_params cf_monos (map cf.cf_type));
-				ignore(List.map follow cf_monos);
-				f#add_functional_interface jfi (List.map (jsignature_of_type gctx) c_monos)
+				Mutex.protect gctx.mutexes.unify (fun () ->
+					Type.unify_custom native_unification_context t (apply_params cf.cf_params cf_monos (map cf.cf_type));
+					ignore(List.map follow cf_monos);
+					f#add_functional_interface jfi (List.map (jsignature_of_type gctx) c_monos)
+				);
 			with Unify_error _ ->
 				()
 		) gctx.functional_interfaces
 	end
 
 let create_typed_function gctx kind jc jm context =
-	let wf = new JvmFunctions.typed_function gctx.typed_functions kind jc jm context in
-	let jc = wf#get_class in
-	Hashtbl.add gctx.known_typed_functions jc#get_this_path ();
-	wf
+	new JvmFunctions.typed_function gctx.typed_functions kind jc jm context
 
 let create_field_closure gctx jc path_this jm name jsig t =
 	let jsig_this = object_path_sig path_this in
 	let context = ["this",jsig_this] in
 	let wf = create_typed_function gctx (FuncMember(path_this,name)) jc jm context in
+	let jc_closure = wf#get_class in
+	Hashtbl.add gctx.closure_paths (path_this,name,jsig) jc_closure#get_this_path;
+	Mutex.unlock gctx.mutexes.closure_lookup;
 	begin match t with
-		| None ->
-			()
-		| Some t ->
-			associate_functional_interfaces gctx wf t
+	| None ->
+		()
+	| Some t ->
+		associate_functional_interfaces gctx wf t
 	end;
-	let jc_closure = wf#get_class in
 	ignore(wf#generate_constructor true);
 	let args,ret = match jsig with
 		| TMethod(args,ret) ->
@@ -492,11 +495,13 @@ let create_field_closure gctx jc path_this jm name jsig t =
 
 let create_field_closure gctx jc path_this jm name jsig f t =
 	let jsig_this = object_path_sig path_this in
+	Mutex.lock gctx.mutexes.closure_lookup;
 	let closure_path = try
-		Hashtbl.find gctx.closure_paths (path_this,name,jsig)
+		let r = Hashtbl.find gctx.closure_paths (path_this,name,jsig) in
+		Mutex.unlock gctx.mutexes.closure_lookup;
+		r;
 	with Not_found ->
 		let closure_path = create_field_closure gctx jc path_this jm name jsig t in
-		Hashtbl.add gctx.closure_paths (path_this,name,jsig) closure_path;
 		closure_path
 	in
 	jm#construct ConstructInit closure_path (fun () ->
@@ -508,6 +513,16 @@ let rvalue_any = RValue(None,None)
 let rvalue_sig jsig = RValue (Some jsig,None)
 let rvalue_type gctx t name = RValue (Some (jsignature_of_type gctx t),name)
 
+type local_ref = (int * (unit -> unit) * (unit -> unit))
+
+type transformed_arg = {
+	a_id : int;
+	a_name : string;
+	a_jsig_arg : jsignature;
+	a_jsig_local : jsignature option;
+	a_texpr : texpr option;
+}
+
 class texpr_to_jvm
 	(gctx : generation_context)
 	(field_info : field_generation_info option)
@@ -537,12 +552,14 @@ class texpr_to_jvm
 	method add_named_local (name : string) (jsig : jsignature) =
 		jm#add_local name jsig VarArgument
 
-	method add_local v init_state : (int * (unit -> unit) * (unit -> unit)) =
-		let t = self#vtype v.v_type in
-		let slot,load,store = jm#add_local v.v_name t init_state in
-		Hashtbl.add local_lookup v.v_id (slot,load,store);
+	method add_local2 id name jsig init_state =
+		let slot,load,store = jm#add_local name jsig init_state in
+		Hashtbl.add local_lookup id (slot,load,store);
 		slot,load,store
 
+	method add_local v init_state =
+		self#add_local2 v.v_id v.v_name (self#vtype v.v_type) init_state
+
 	method get_local_by_id (vid,vname) =
 		if vid = 0 && env = None then
 			(0,(fun () -> jm#load_this),(fun () -> die "" __LOC__))
@@ -592,6 +609,49 @@ class texpr_to_jvm
 		jm_init#construct ConstructInit jc_closure#get_this_path (fun () -> []);
 		jm_init#putstatic jc_closure#get_this_path jf_closure#get_name jf_closure#get_jsig;
 
+	method transform_arg (v : tvar) (eo : texpr option) =
+		let jsig_local = self#vtype v.v_type in
+		let dual_vars = eo <> None && is_unboxed jsig_local in
+		let jsig_arg = if dual_vars then get_boxed_type jsig_local else jsig_local in
+		{
+			a_id = v.v_id;
+			a_name = v.v_name;
+			a_jsig_arg = jsig_arg;
+			a_jsig_local = if dual_vars then Some jsig_local else None;
+			a_texpr = eo;
+		}
+
+	method handle_arg_inits (jm : JvmMethod.builder) (handler : texpr_to_jvm) (actual_args : local_ref list) (args : transformed_arg list) =
+		List.iter2 (fun (slot,load,store) arg -> match arg.a_texpr with
+			| Some e when (match e.eexpr with TConst TNull -> false | _ -> true) ->
+				begin match arg.a_jsig_local with
+					| Some jsig_local ->
+						load();
+						jm#if_then_else
+							(jm#get_code#if_nonnull arg.a_jsig_arg)
+							(fun () ->
+								handler#texpr (rvalue_sig jsig_local) e;
+							)
+							(fun () ->
+								load();
+								jm#cast jsig_local;
+							);
+						let _,_,store = handler#add_local2 arg.a_id arg.a_name jsig_local VarWillInit in
+						store();
+					| None ->
+						load();
+						jm#if_then
+							(jm#get_code#if_nonnull arg.a_jsig_arg)
+							(fun () ->
+								handler#texpr (rvalue_sig arg.a_jsig_arg) e;
+								jm#cast arg.a_jsig_arg;
+								store();
+							)
+				end
+			| _ ->
+				()
+		) actual_args args
+
 	method tfunction ret e tf =
 		let outside,accesses_this = Texpr.collect_captured_vars e in
 		let env = List.map (fun v ->
@@ -612,34 +672,17 @@ class texpr_to_jvm
 			| _ -> []
 		in
 		let args,ret =
-			let args = List.map (fun (v,eo) ->
-				(* TODO: Can we do this differently? *)
-				if eo <> None then v.v_type <- self#mknull v.v_type;
-				v.v_name,self#vtype v.v_type
-			) tf.tf_args in
+			let args = List.map (fun (v,eo) -> self#transform_arg v eo) tf.tf_args in
 			args,(return_of_type gctx tf.tf_type)
 		in
-		let jm_invoke = wf#generate_invoke args ret filter in
+		let jm_invoke = wf#generate_invoke (List.map (fun arg -> arg.a_name,arg.a_jsig_arg) args) ret filter in
 		let handler = new texpr_to_jvm gctx field_info jc_closure jm_invoke ret in
 		handler#set_env env;
-		let args = List.map (fun (v,eo) ->
-			handler#add_local v VarArgument,v,eo
-		) tf.tf_args in
+		let actual_args = List.map (fun arg ->
+			handler#add_local2 arg.a_id arg.a_name arg.a_jsig_arg VarArgument
+		) args in
 		jm_invoke#finalize_arguments;
-		List.iter (fun ((_,load,save),v,eo) -> match eo with
-			| Some e when (match e.eexpr with TConst TNull -> false | _ -> true) ->
-				load();
-				let jsig = self#vtype v.v_type in
-				jm_invoke#if_then
-					(jm_invoke#get_code#if_nonnull jsig)
-					(fun () ->
-						handler#texpr (rvalue_sig jsig) e;
-						jm_invoke#cast jsig;
-						save();
-					)
-			| _ ->
-				()
-		) args;
+		self#handle_arg_inits jm_invoke handler actual_args args;
 		handler#texpr RReturn tf.tf_expr;
 		begin match env with
 		| [] ->
@@ -690,12 +733,17 @@ class texpr_to_jvm
 
 	method read_static_closure (path : path) (name : string) (args : (string * jsignature) list) (ret : jsignature option) (t : Type.t) =
 		let jsig = method_sig (List.map snd args) ret in
+		Mutex.lock gctx.mutexes.closure_lookup;
 		let closure_path = try
-			Hashtbl.find gctx.closure_paths (path,name,jsig)
+			let r = Hashtbl.find gctx.closure_paths (path,name,jsig) in
+			Mutex.unlock gctx.mutexes.closure_lookup;
+			r
 		with Not_found ->
 			let wf = create_typed_function gctx (FuncStatic(path,name)) jc jm [] in
-			associate_functional_interfaces gctx wf t;
 			let jc_closure = wf#get_class in
+			Hashtbl.add gctx.closure_paths (path,name,jsig) jc_closure#get_this_path;
+			Mutex.unlock gctx.mutexes.closure_lookup;
+			associate_functional_interfaces gctx wf t;
 			ignore(wf#generate_constructor false);
 			let jm_invoke = wf#generate_invoke args ret [] in
 			let vars = List.map (fun (name,jsig) ->
@@ -707,7 +755,7 @@ class texpr_to_jvm
 			) vars;
 			jm_invoke#invokestatic path name (method_sig (List.map snd args) ret);
 			jm_invoke#return;
-			Hashtbl.add gctx.closure_paths (path,name,jsig) jc_closure#get_this_path;
+
 			(* Static init *)
 			self#make_static_closure_field name jc_closure;
 			write_class gctx jc_closure#get_this_path (jc_closure#export_class gctx.default_export_config);
@@ -1069,9 +1117,9 @@ class texpr_to_jvm
 			jm#invokestatic haxe_jvm_path "compare" (method_sig [object_sig;object_sig] (Some TInt));
 			let op = flip_cmp_op op in
 			CmpNormal(op,TBool)
-		| [sig2;TObject(path1,_)] when Hashtbl.mem gctx.known_typed_functions path1 ->
+		| [sig2;TObject(path1,_)] when jc#has_typed_function path1 || path1 = haxe_function_path ->
 			fun_compare path1 sig2
-		| [TObject(path1,_);sig2] when Hashtbl.mem gctx.known_typed_functions path1 ->
+		| [TObject(path1,_);sig2] when jc#has_typed_function path1 || path1 = haxe_function_path ->
 			code#swap;
 			fun_compare path1 sig2
 		| [(TObject _ | TArray _ | TMethod _) as t1;(TObject _ | TArray _ | TMethod _) as t2] ->
@@ -1915,7 +1963,7 @@ class texpr_to_jvm
 		if not jm#is_terminated then self#texpr' ret e
 
 	method texpr' ret e =
-		code#set_line (Lexer.get_error_line e.epos);
+		code#set_line (Lexer.get_error_line_if_exists e.epos);
 		match e.eexpr with
 		| TVar(v,Some e1) ->
 			self#texpr (rvalue_type gctx v.v_type (Some v.v_name)) e1;
@@ -2501,12 +2549,16 @@ class tclass_to_jvm gctx c = object(self)
 				e,[],None
 		in
 		let handler = new texpr_to_jvm gctx field_info jc jm tr in
-		List.iter (fun (v,_) ->
-			let slot,_,_ = handler#add_local v VarArgument in
+		let arg_pairs = List.map (fun (v,eo) ->
+			let arg = handler#transform_arg v eo in
+			let slot,load,store = handler#add_local2 arg.a_id arg.a_name arg.a_jsig_arg VarArgument in
 			let l = AnnotationHandler.convert_annotations v.v_meta in
 			List.iter (fun (path,annotation,is_runtime_visible) -> jm#add_argument_annotation slot path annotation is_runtime_visible) l;
-		) args;
+			(arg,(slot,load,store))
+		) args in
 		jm#finalize_arguments;
+		let args,actual_args = List.split arg_pairs in
+		handler#handle_arg_inits jm handler actual_args args;
 		begin match mtype with
 		| MConstructor ->
 			DynArray.iter (fun e ->
@@ -2892,8 +2944,8 @@ let generate_module_type ctx mt =
 		| TEnumDecl en when not (has_enum_flag en EnExtern) -> generate_enum ctx en
 		| _ -> ()
 
-let generate_anons gctx =
-	Hashtbl.iter (fun _ pfm ->
+let generate_anons gctx pool =
+	let run (_,pfm) =
 		let path = pfm.pfm_path in
 		let fields = convert_fields gctx pfm in
 		let jc = new JvmClass.builder path haxe_dynamic_object_path in
@@ -2959,7 +3011,9 @@ let generate_anons gctx =
 			) c.cl_ordered_fields
 		end;
 		write_class gctx path (jc#export_class gctx.default_export_config)
-	) gctx.anon_identification#get_pfms
+	in
+	let seq = Hashtbl.to_seq gctx.anon_identification#get_pfms in
+	Parallel.ParallelSeq.iter pool run seq
 
 let generate_typed_functions gctx =
 	let jc_function = gctx.typed_functions#generate in
@@ -3026,8 +3080,11 @@ module Preprocessor = struct
 				match mt with
 				| TClassDecl c when has_runtime_meta c.cl_meta && has_class_flag c CInterface ->
 					() (* TODO: run-time interface metadata is a problem (issue #2042) *)
-				| TClassDecl _ | TEnumDecl _ ->
+				| TClassDecl _ ->
+					check_path (t_infos mt);
+				| TEnumDecl en ->
 					check_path (t_infos mt);
+					Hashtbl.replace gctx.enum_paths en.e_path ();
 				| TTypeDecl td ->
 					check_path (t_infos mt);
 					gctx.anon_identification#identify_typedef td
@@ -3036,13 +3093,24 @@ module Preprocessor = struct
 			) m.m_types
 		) gctx.gctx.modules;
 		(* preprocess classes *)
+		let patch_optional c =
+			let apply cf =
+				patch_optional gctx.gctx.basic cf;
+			in
+			List.iter apply c.cl_ordered_fields;
+			List.iter apply c.cl_ordered_statics;
+			Option.may apply c.cl_constructor;
+		in
 		List.iter (fun mt ->
 			match mt with
 			| TClassDecl c ->
 				if not (has_class_flag c CInterface) then
 					gctx.preprocessor#preprocess_class c
-				else if has_class_flag c CFunctionalInterface then
+				else begin
+					patch_optional c;
+					if has_class_flag c CFunctionalInterface then
 					check_functional_interface gctx c
+				end
 			| _ -> ()
 		) gctx.gctx.types;
 		(* find typedef-interface implementations *)
@@ -3109,19 +3177,21 @@ let generate jvm_flag gctx =
 		preprocessor = Obj.magic ();
 		typedef_interfaces = Obj.magic ();
 		typed_functions = new JvmFunctions.typed_functions;
-		known_typed_functions = Hashtbl.create 0;
 		closure_paths = Hashtbl.create 0;
 		enum_paths = Hashtbl.create 0;
 		default_export_config = {
 			export_debug = true;
 		};
 		detail_times = Gctx.raw_defined gctx "jvm_times";
-		timer = new Timer.timer ["generate";"java"];
 		jar_compression_level = compression_level;
 		dynamic_level = dynamic_level;
 		functional_interfaces = [];
+		mutexes = {
+			write_class = Mutex.create();
+			unify = Mutex.create();
+			closure_lookup = Mutex.create();
+		}
 	} in
-	Hashtbl.add gctx.known_typed_functions haxe_function_path ();
 	gctx.preprocessor <- new preprocessor gctx.gctx.basic (jsignature_of_type gctx);
 	gctx.typedef_interfaces <- new typedef_interfaces gctx.preprocessor#get_infos anon_identification;
 	gctx.typedef_interfaces#add_interface_rewrite (["haxe";"root"],"Iterator") (["java";"util"],"Iterator") true;
@@ -3144,17 +3214,22 @@ let generate jvm_flag gctx =
 		let filename = StringHelper.escape_res_name name ['/';'-'] in
 		gctx.out#add_entry v filename;
 	) gctx.gctx.resources;
-	let generate_real_types () =
-		List.iter (generate_module_type gctx) gctx.gctx.types;
-	in
-	let generate_typed_interfaces () =
-		Hashtbl.iter (fun _ c -> generate_module_type gctx (TClassDecl c)) gctx.typedef_interfaces#get_interfaces;
+
+	let generate pool =
+		let generate_real_types () =
+			Parallel.ParallelArray.iter pool (generate_module_type gctx) (Array.of_list gctx.gctx.types)
+		in
+		let generate_typed_interfaces () =
+			let seq = Hashtbl.to_seq gctx.typedef_interfaces#get_interfaces in
+			Parallel.ParallelSeq.iter pool (fun (_,c) -> generate_module_type gctx (TClassDecl c)) seq;
+		in
+		run_timed gctx false "preprocess" (fun () -> Preprocessor.preprocess gctx);
+		run_timed gctx false "real types" generate_real_types;
+		run_timed gctx false "typed interfaces" generate_typed_interfaces;
+		run_timed gctx false "anons" (fun () -> generate_anons gctx pool);
+		run_timed gctx false "typed_functions" (fun () -> generate_typed_functions gctx);
 	in
-	run_timed gctx false "preprocess" (fun () -> Preprocessor.preprocess gctx);
-	run_timed gctx false "real types" generate_real_types;
-	run_timed gctx false "typed interfaces" generate_typed_interfaces;
-	run_timed gctx false "anons" (fun () -> generate_anons gctx);
-	run_timed gctx false "typed_functions" (fun () -> generate_typed_functions gctx);
+	Parallel.run_in_new_pool gctx.gctx.timer_ctx generate;
 
 	let manifest_content =
 		"Manifest-Version: 1.0\n" ^

+ 18 - 0
src/generators/genshared.ml

@@ -52,6 +52,22 @@ module Info = struct
 	end
 end
 
+let rec patch_optional basic cf =
+	List.iter (patch_optional basic) cf.cf_overloads;
+	match follow cf.cf_type with
+		| TFun(args,ret) ->
+			let args = List.map (fun (n,o,t) ->
+				let o,t = if o && not (is_nullable t) then
+					(o,basic.tnull t)
+				else
+					(o,t)
+				in
+				(n,o,t)
+			) args in
+			cf.cf_type <- TFun(args,ret)
+		| _ ->
+			()
+
 open Info
 open OverloadResolution
 open Tanon_identification
@@ -170,6 +186,7 @@ object(self)
 		let has_dynamic_instance_method = ref false in
 		let has_field_init = ref false in
 		let field mtype cf =
+			patch_optional basic cf;
 			match mtype with
 			| MConstructor ->
 				()
@@ -199,6 +216,7 @@ object(self)
 				()
 			end;
 		| Some cf ->
+			patch_optional basic cf;
 			let field cf =
 				if !has_dynamic_instance_method then make_haxe cf;
 				begin match cf.cf_expr with

+ 18 - 18
src/generators/genswf.ml

@@ -614,24 +614,24 @@ let generate swf_header swf_libs flash_version com =
 		{header with h_frame_count = header.h_frame_count + 1},loop tags
 	| _ -> swf in
 	(* write swf/swc *)
-	let t = Timer.timer ["write";"swf"] in
-	let level = (try int_of_string (Gctx.defined_value com Define.SwfCompressLevel) with Not_found -> 9) in
-	SwfParser.init Extc.input_zip (Extc.output_zip ~level);
-	(match swc with
-	| Some cat ->
-		let ch = IO.output_strings() in
-		Swf.write ch swf;
-		let swf = IO.close_out ch in
-		let z = Zip.open_out file in
-		Zip.add_entry (!cat) z "catalog.xml";
-		Zip.add_entry (match swf with [s] -> s | _ -> failwith "SWF too big for SWC") z ~level:0 "library.swf";
-		Zip.close_out z
-	| None ->
-		let ch = IO.output_channel (open_out_bin file) in
-		Swf.write ch swf;
-		IO.close_out ch;
-	);
-	t()
+	Timer.time com.timer_ctx ["write";"swf"] (fun () ->
+		let level = (try int_of_string (Gctx.defined_value com Define.SwfCompressLevel) with Not_found -> 9) in
+		SwfParser.init Extc.input_zip (Extc.output_zip ~level);
+		(match swc with
+		| Some cat ->
+			let ch = IO.output_strings() in
+			Swf.write ch swf;
+			let swf = IO.close_out ch in
+			let z = Zip.open_out file in
+			Zip.add_entry (!cat) z "catalog.xml";
+			Zip.add_entry (match swf with [s] -> s | _ -> failwith "SWF too big for SWC") z ~level:0 "library.swf";
+			Zip.close_out z
+		| None ->
+			let ch = IO.output_channel (open_out_bin file) in
+			Swf.write ch swf;
+			IO.close_out ch;
+		);
+	) ()
 
 ;;
 SwfParser.init Extc.input_zip Extc.output_zip;

+ 1 - 1
src/generators/genswf9.ml

@@ -2863,7 +2863,7 @@ let generate com boot_name =
 		try_scope_reg = None;
 		for_call = false;
 	} in
-	let types = if ctx.swc && com.main.main_class = None then
+	let types = if ctx.swc && com.main.main_path = None then
 		(*
 			make sure that both Boot and RealBoot are the first two classes in the SWC
 			this way initializing RealBoot will also run externs __init__ blocks before

+ 233 - 171
src/generators/hl2c.ml

@@ -56,29 +56,34 @@ and function_entry = {
 	mutable fe_calling : function_entry list;
 }
 
-type context = {
+type global_context = {
 	version : int;
-	out : Buffer.t;
-	mutable tabs : string;
+	hash_mutex : Mutex.t;
 	hash_cache : (int, int32) Hashtbl.t;
 	hash_mem : (int32, bool) Hashtbl.t;
 	mutable hash_cache_list : int list;
 	hlcode : code;
 	dir : string;
-	mutable curfile : string;
 	mutable cfiles : string list;
 	ftable : function_entry array;
 	htypes : (ttype, string) PMap.t;
 	gnames : string array;
 	bytes_names : string array;
+	mutable type_module : (ttype, code_module) PMap.t;
+	gcon : Gctx.t;
+}
+
+type file_context = {
+	out : Buffer.t;
+	mutable tabs : string;
+	dir : string;
+	curfile : string;
 	mutable defines : string list;
 	defined_funs : (int, unit) Hashtbl.t;
 	hdefines : (string, unit) Hashtbl.t;
 	mutable defined_types : (ttype, unit) PMap.t;
-	mutable file_prefix : string;
 	mutable fun_index : int;
-	mutable type_module : (ttype, code_module) PMap.t;
-	gcon : Gctx.t;
+	file_prefix : string;
 }
 
 let sprintf = Printf.sprintf
@@ -216,8 +221,10 @@ let unblock ctx =
 	ctx.tabs <- String.sub ctx.tabs 0 (String.length ctx.tabs - 1)
 
 let hash ctx sid =
+	Mutex.protect ctx.hash_mutex (fun () ->
 	try
-		Hashtbl.find ctx.hash_cache sid
+		let h = Hashtbl.find ctx.hash_cache sid in
+		h
 	with Not_found ->
 		let rec loop h =
 			if Hashtbl.mem ctx.hash_mem h then loop (Int32.add h Int32.one) else h
@@ -227,6 +234,7 @@ let hash ctx sid =
 		Hashtbl.add ctx.hash_mem h true;
 		ctx.hash_cache_list <- sid :: ctx.hash_cache_list;
 		h
+	)
 
 let type_name ctx t =
 	try PMap.find t ctx.htypes with Not_found -> Globals.die (tstr t) __LOC__
@@ -237,38 +245,38 @@ let define ctx s =
 		Hashtbl.add ctx.hdefines s ();
 	end
 
-let rec define_type ctx t =
+let rec define_type gctx ctx t =
 	match t with
 	| HVoid | HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64 | HBool | HBytes | HDyn | HArray _ | HType | HDynObj | HNull _ | HRef _ | HGUID -> ()
 	| HAbstract _ ->
 		define ctx "#include <hl/natives.h>";
 	| HFun (args,ret) | HMethod (args,ret) ->
-		List.iter (define_type ctx) args;
-		define_type ctx ret
+		List.iter (define_type gctx ctx) args;
+		define_type gctx ctx ret
 	| HEnum _ | HObj _ | HStruct _ when not (PMap.exists t ctx.defined_types) ->
 		ctx.defined_types <- PMap.add t () ctx.defined_types;
-		define ctx (sprintf "#include <%s.h>" (try PMap.find t ctx.type_module with Not_found -> Globals.die "" __LOC__).m_name)
+		define ctx (sprintf "#include <%s.h>" (try PMap.find t gctx.type_module with Not_found -> Globals.die "" __LOC__).m_name)
 	| HVirtual vp when not (PMap.exists t ctx.defined_types) ->
 		ctx.defined_types <- PMap.add t () ctx.defined_types;
-		Array.iter (fun (_,_,t) -> define_type ctx t) vp.vfields
+		Array.iter (fun (_,_,t) -> define_type gctx ctx t) vp.vfields
 	| HPacked t ->
-		define_type ctx t
+		define_type gctx ctx t
 	| HEnum _ | HObj _ | HStruct _ | HVirtual _ ->
 		()
 
-let type_value ctx t =
-	let n = type_name ctx t in
+let type_value gctx ctx t =
+	let n = type_name gctx t in
 	define ctx (sprintf "extern hl_type %s;" n);
 	"&" ^ n
 
-let enum_constr_type ctx e i =
-	define_type ctx (HEnum e);
+let enum_constr_type gctx ctx e i =
+	define_type gctx ctx (HEnum e);
 	let cname,_, tl = e.efields.(i) in
 	if Array.length tl = 0 then
 		"venum"
 	else
 	let name = if e.eid = 0 then
-		let name = (try PMap.find (HEnum e) ctx.htypes with Not_found -> Globals.die "" __LOC__) in
+		let name = (try PMap.find (HEnum e) gctx.htypes with Not_found -> Globals.die "" __LOC__) in
 		"Enum" ^ name
 	else
 		String.concat "_" (ExtString.String.nsplit e.ename ".")
@@ -284,12 +292,12 @@ let output ctx str =
 let output_char ctx c =
 	Buffer.add_char ctx.out c
 
-let line ctx str =
+let linec ctx str =
 	output ctx ctx.tabs;
 	output ctx str;
 	output_char ctx '\n'
 
-let expr ctx str =
+let exprc ctx str =
 	output ctx ctx.tabs;
 	output ctx str;
 	output ctx ";\n"
@@ -301,6 +309,11 @@ let obj_field fid name =
 
 let bom = "\xEF\xBB\xBF"
 
+let save_cfile gctx file =
+	if String.sub file (String.length file - 2) 2 = ".c" then begin
+		gctx.cfiles <- file :: gctx.cfiles;
+	end
+
 let close_file ctx =
 	let out = Buffer.contents ctx.out in
 	let defines = List.rev ctx.defines in
@@ -312,23 +325,20 @@ let close_file ctx =
 	Hashtbl.clear ctx.defined_funs;
 	Buffer.reset ctx.out;
 	let fpath = ctx.dir ^ "/" ^ ctx.curfile in
-	if String.sub ctx.curfile (String.length ctx.curfile - 2) 2 = ".c" then ctx.cfiles <- ctx.curfile :: ctx.cfiles;
-	ctx.curfile <- "";
 	let fcontent = (try Std.input_file ~bin:true fpath with _ -> "") in
 	if fcontent <> str then begin
-		Path.mkdir_recursive "" (ExtString.String.nsplit (Filename.dirname fpath) "/");
 		let ch = open_out_bin fpath in
 		output_string ch str;
 		close_out ch;
 	end
 
-let define_global ctx g =
-	let t = ctx.hlcode.globals.(g) in
-	define_type ctx t;
-	define ctx (sprintf "extern %s;" (var_type ctx.gnames.(g) t))
+let define_global gctx ctx g =
+	let t = gctx.hlcode.globals.(g) in
+	define_type gctx ctx t;
+	define ctx (sprintf "extern %s;" (var_type gctx.gnames.(g) t))
 
-let define_function ctx fid =
-	let ft = ctx.ftable.(fid) in
+let define_function gctx ctx fid =
+	let ft = gctx.ftable.(fid) in
 	let fid = if ft.fe_decl = None then -1 else fid in
 	if not (Hashtbl.mem ctx.defined_funs fid) then begin
 		Hashtbl.add ctx.defined_funs fid ();
@@ -336,7 +346,7 @@ let define_function ctx fid =
 		| None ->
 			define ctx "#include <hl/natives.h>"
 		| Some f ->
-			define_type ctx f.ftype;
+			define_type gctx ctx f.ftype;
 			ctx.defines <- sprintf "%s %s(%s);" (ctype ft.fe_ret) ft.fe_name (args_repr ft.fe_args) :: ctx.defines);
 	end;
 	ft.fe_name
@@ -344,18 +354,31 @@ let define_function ctx fid =
 let short_digest str =
 	String.sub (Digest.to_hex (Digest.string str)) 0 7
 
-let open_file ctx file =
-	if ctx.curfile <> "" then close_file ctx;
+let create_file_context dir file =
+	let ctx = {
+		out = Buffer.create 1024;
+		tabs = "";
+		dir = dir;
+		curfile = file;
+		defines = [];
+		hdefines = Hashtbl.create 0;
+		defined_funs = Hashtbl.create 0;
+		defined_types = PMap.empty;
+		fun_index = 0;
+		file_prefix = (short_digest file) ^ "_";
+	} in
+	ctx
+
+let open_file (gctx:global_context) file =
+	let ctx = create_file_context gctx.dir file in
 	if file <> "hlc.json" then
-		Gctx.map_source_header ctx.gcon.defines (fun s -> define ctx (sprintf "// %s" s));
-	ctx.curfile <- file;
-	ctx.fun_index <- 0;
-	ctx.file_prefix <- (short_digest file) ^ "_"
+		Gctx.map_source_header gctx.gcon.defines (fun s -> define ctx (sprintf "// %s" s));
+	ctx
 
 let string_data_limit = 64
 
-let string ctx sid =
-	let s = ctx.hlcode.strings.(sid) in
+let string gctx ctx sid =
+	let s = gctx.hlcode.strings.(sid) in
 	if String.length s < string_data_limit then
 		sprintf "USTR(\"%s\")" (StringHelper.s_escape s)
 	else begin
@@ -364,8 +387,8 @@ let string ctx sid =
 		sprintf "string$%s" id
 	end
 
-let generate_reflection ctx =
-	let line = line ctx and expr = expr ctx in
+let generate_reflection gctx ctx =
+	let line = linec ctx and expr = exprc ctx in
 	let sline fmt = Printf.ksprintf line fmt and sexpr fmt = Printf.ksprintf expr fmt in
 
 	let funByArgs = Hashtbl.create 0 in
@@ -400,8 +423,8 @@ let generate_reflection ctx =
 				| _ -> ())
 			| _ -> ()
 		) f.code
-	) ctx.hlcode.functions;
-	Array.iter (fun f -> add_fun f.fe_args f.fe_ret) ctx.ftable;
+	) gctx.hlcode.functions;
+	Array.iter (fun f -> add_fun f.fe_args f.fe_ret) gctx.ftable;
 	let argsCounts = List.sort compare (Hashtbl.fold (fun i _ acc -> i :: acc) funByArgs []) in
 	sexpr "static int TKIND[] = {%s}" (String.concat "," (List.map (fun t -> string_of_int (type_kind_id (type_kind t))) core_types));
 	line "";
@@ -519,13 +542,13 @@ let generate_reflection ctx =
 	line "}";
 	line ""
 
-let generate_function ctx f =
-	let line = line ctx and expr = expr ctx in
+let generate_function gctx ctx f =
+	let line = linec ctx and expr = exprc ctx in
 	let sline fmt = Printf.ksprintf line fmt and sexpr fmt = Printf.ksprintf expr fmt in
 	let define fmt = Printf.ksprintf (define ctx) fmt in
 	let block() = block ctx and unblock() = unblock ctx in
-	let type_value = type_value ctx in
-	let code = ctx.hlcode in
+	let type_value = type_value gctx in
+	let code = gctx.hlcode in
 
 	let rid = ref (-1) in
 	let cl_id = ref 0 in
@@ -534,12 +557,12 @@ let generate_function ctx f =
 	let label p = sprintf "label$%s%d_%d" ctx.file_prefix ctx.fun_index p in
 	ctx.fun_index <- ctx.fun_index + 1;
 	Hashtbl.add ctx.defined_funs f.findex ();
-	Array.iter (define_type ctx) f.regs;
-	define_type ctx f.ftype;
+	Array.iter (define_type gctx ctx) f.regs;
+	define_type gctx ctx f.ftype;
 
 	let rtype r = f.regs.(r) in
 
-	let funname fid = define_function ctx fid in
+	let funname fid = define_function gctx ctx fid in
 
 	let rcast r t =
 		let rt = (rtype r) in
@@ -567,7 +590,7 @@ let generate_function ctx f =
 	in
 
 	let ocall r fid args =
-		let ft = ctx.ftable.(fid) in
+		let ft = gctx.ftable.(fid) in
 		let rstr = rassign r ft.fe_ret in
 		sexpr "%s%s(%s)" rstr (funname fid) (String.concat "," (List.map2 rcast args ft.fe_args))
 	in
@@ -582,7 +605,7 @@ let generate_function ctx f =
 	in
 
 	let type_value_opt t =
-		match t with HF32 | HF64 | HI64 -> "" | _ -> "," ^ type_value t
+		match t with HF32 | HF64 | HI64 -> "" | _ -> "," ^ type_value ctx t
 	in
 
 	let dyn_call r f pl =
@@ -596,7 +619,7 @@ let generate_function ctx f =
 				if is_dynamic t then
 					sprintf "(vdynamic*)%s" (reg p)
 				else
-					sprintf "hl_make_dyn(&%s,%s)" (reg p) (type_value t)
+					sprintf "hl_make_dyn(&%s,%s)" (reg p) (type_value ctx t)
 		) pl));
 		let rt = rtype r in
 		let ret = if rt = HVoid then "" else if is_dynamic rt then sprintf "%s = (%s)" (reg r) (ctype rt) else "vdynamic *ret = " in
@@ -629,7 +652,7 @@ let generate_function ctx f =
 				let rt = rtype r in
 				let ret = if rt = HVoid then "" else if is_ptr rt then sprintf "%s = (%s)" (reg r) (ctype rt) else begin sexpr "vdynamic ret"; ""; end in
 				let fname, fid, ft = vp.vfields.(fid) in
-				sexpr "%shl_dyn_call_obj(%s->value,%s,%ld/*%s*/,%s,%s)" ret (reg o) (type_value ft) (hash ctx fid) fname (if args = [] then "NULL" else "args") (if is_ptr rt || rt == HVoid then "NULL" else "&ret");
+				sexpr "%shl_dyn_call_obj(%s->value,%s,%ld/*%s*/,%s,%s)" ret (reg o) (type_value ctx ft) (hash gctx fid) fname (if args = [] then "NULL" else "args") (if is_ptr rt || rt == HVoid then "NULL" else "&ret");
 				if rt <> HVoid && not (is_ptr rt) then sexpr "%s = (%s)ret.v.%s" (reg r) (ctype rt) (dyn_prefix rt);
 				unblock();
 				sline "}"
@@ -644,7 +667,7 @@ let generate_function ctx f =
 			sexpr "%s->%s = %s" (reg obj) (obj_field fid name) (rcast v t)
 		| HVirtual vp ->
 			let name, nid, t = vp.vfields.(fid) in
-			let dset = sprintf "hl_dyn_set%s(%s->value,%ld/*%s*/%s,%s)" (dyn_prefix t) (reg obj) (hash ctx nid) name (type_value_opt (rtype v)) (reg v) in
+			let dset = sprintf "hl_dyn_set%s(%s->value,%ld/*%s*/%s,%s)" (dyn_prefix t) (reg obj) (hash gctx nid) name (type_value_opt (rtype v)) (reg v) in
 			sexpr "if( hl_vfields(%s)[%d] ) *(%s*)(hl_vfields(%s)[%d]) = (%s)%s; else %s" (reg obj) fid (ctype t) (reg obj) fid (ctype t) (reg v) dset
 		| _ ->
 			Globals.die "" __LOC__
@@ -657,7 +680,7 @@ let generate_function ctx f =
 			sexpr "%s%s->%s" (rassign r t) (reg obj) (obj_field fid name)
 		| HVirtual v ->
 			let name, nid, t = v.vfields.(fid) in
-			let dget = sprintf "(%s)hl_dyn_get%s(%s->value,%ld/*%s*/%s)" (ctype t) (dyn_prefix t) (reg obj) (hash ctx nid) name (type_value_opt t) in
+			let dget = sprintf "(%s)hl_dyn_get%s(%s->value,%ld/*%s*/%s)" (ctype t) (dyn_prefix t) (reg obj) (hash gctx nid) name (type_value_opt t) in
 			sexpr "%shl_vfields(%s)[%d] ? (*(%s*)(hl_vfields(%s)[%d])) : %s" (rassign r t) (reg obj) fid (ctype t) (reg obj) fid dget
 		| _ ->
 			Globals.die "" __LOC__
@@ -698,8 +721,8 @@ let generate_function ctx f =
 		| OEndTrap true ->
 			decr trap_depth
 		| OStaticClosure (_, fid) ->
-			let ft = ctx.ftable.(fid) in
-			sexpr "static vclosure cl$%d = { %s, %s, 0 }" (!cl_id) (type_value (HFun (ft.fe_args,ft.fe_ret))) (funname fid);
+			let ft = gctx.ftable.(fid) in
+			sexpr "static vclosure cl$%d = { %s, %s, 0 }" (!cl_id) (type_value ctx (HFun (ft.fe_args,ft.fe_ret))) (funname fid);
 			incr cl_id;
 		| _ ->
 			()
@@ -819,10 +842,10 @@ let generate_function ctx f =
 		| OBool (r,b) ->
 			sexpr "%s = %s" (reg r) (if b then "true" else "false")
 		| OBytes (r,idx) ->
-			define "extern vbyte %s[];" ctx.bytes_names.(idx);
-			sexpr "%s = %s" (reg r) ctx.bytes_names.(idx)
+			define "extern vbyte %s[];" gctx.bytes_names.(idx);
+			sexpr "%s = %s" (reg r) gctx.bytes_names.(idx)
 		| OString (r,idx) ->
-			sexpr "%s = (vbyte*)%s" (reg r) (string ctx idx)
+			sexpr "%s = (vbyte*)%s" (reg r) (string gctx ctx idx)
 		| ONull r ->
 			sexpr "%s = NULL" (reg r)
 		| OAdd (r,a,b) ->
@@ -903,22 +926,22 @@ let generate_function ctx f =
 			sexpr "%s = &cl$%d" (reg r) (!cl_id);
 			incr cl_id
 		| OInstanceClosure (r,fid,ptr) ->
-			let ft = ctx.ftable.(fid) in
-			sexpr "%s = hl_alloc_closure_ptr(%s,%s,%s)" (reg r) (type_value (HFun (ft.fe_args,ft.fe_ret))) (funname fid) (reg ptr)
+			let ft = gctx.ftable.(fid) in
+			sexpr "%s = hl_alloc_closure_ptr(%s,%s,%s)" (reg r) (type_value ctx (HFun (ft.fe_args,ft.fe_ret))) (funname fid) (reg ptr)
 		| OVirtualClosure (r,o,m) ->
 			(match rtype o with
 			| HObj p ->
-				let ft = ctx.ftable.(p.pvirtuals.(m)) in
+				let ft = gctx.ftable.(p.pvirtuals.(m)) in
 				let s = sprintf "%s->$type->vobj_proto[%d]" (reg o) m in
-				sexpr "%s = hl_alloc_closure_ptr(%s,%s,%s)" (reg r) (type_value (HFun(ft.fe_args,ft.fe_ret))) s (reg o)
+				sexpr "%s = hl_alloc_closure_ptr(%s,%s,%s)" (reg r) (type_value ctx (HFun(ft.fe_args,ft.fe_ret))) s (reg o)
 			| _ ->
 				todo())
 		| OGetGlobal (r,g) ->
-			define_global ctx g;
-			sexpr "%s = (%s)%s" (reg r) (ctype (rtype r)) ctx.gnames.(g)
+			define_global gctx ctx g;
+			sexpr "%s = (%s)%s" (reg r) (ctype (rtype r)) gctx.gnames.(g)
 		| OSetGlobal (g,r) ->
-			define_global ctx g;
-			sexpr "%s = (%s)%s" ctx.gnames.(g) (ctype code.globals.(g)) (reg r)
+			define_global gctx ctx g;
+			sexpr "%s = (%s)%s" gctx.gnames.(g) (ctype code.globals.(g)) (reg r)
 		| ORet r ->
 			if rtype r = HVoid then expr "return" else sexpr "return %s" (rcast r fret)
 		| OJTrue (r,d) | OJNotNull (r,d) ->
@@ -956,7 +979,7 @@ let generate_function ctx f =
 				sline "if( %s == NULL ) %s = NULL; else {" (reg v) (reg r);
 				block();
 			end;
-			sexpr "%s = hl_alloc_dynamic(%s)" (reg r) (type_value (rtype v));
+			sexpr "%s = hl_alloc_dynamic(%s)" (reg r) (type_value ctx (rtype v));
 			(match rtype v with
 			| HUI8 | HUI16 | HI32 | HBool ->
 				sexpr "%s->v.i = %s" (reg r) (reg v)
@@ -980,9 +1003,9 @@ let generate_function ctx f =
 			sexpr "%s = (int)%s" (reg r) (reg v)
 		| ONew r ->
 			(match rtype r with
-			| HObj o | HStruct o -> sexpr "%s = (%s)hl_alloc_obj(%s)" (reg r) (tname o.pname) (type_value (rtype r))
+			| HObj o | HStruct o -> sexpr "%s = (%s)hl_alloc_obj(%s)" (reg r) (tname o.pname) (type_value ctx (rtype r))
 			| HDynObj -> sexpr "%s = hl_alloc_dynobj()" (reg r)
-			| HVirtual _ as t -> sexpr "%s = hl_alloc_virtual(%s)" (reg r) (type_value t)
+			| HVirtual _ as t -> sexpr "%s = hl_alloc_virtual(%s)" (reg r) (type_value ctx t)
 			| _ -> Globals.die "" __LOC__)
 		| OField (r,obj,fid) ->
 			get_field r obj fid
@@ -1030,13 +1053,13 @@ let generate_function ctx f =
 			if tsrc = HNull t then
 				sexpr "%s = %s ? %s%s : 0" (reg r) (reg v) (reg v) (dyn_value_field t)
 			else
-				sexpr "%s = (%s)hl_dyn_cast%s(&%s,%s%s)" (reg r) (ctype t) (dyn_prefix t) (reg v) (type_value (rtype v)) (type_value_opt t)
+				sexpr "%s = (%s)hl_dyn_cast%s(&%s,%s%s)" (reg r) (ctype t) (dyn_prefix t) (reg v) (type_value ctx (rtype v)) (type_value_opt t)
 		| OUnsafeCast (r,v) ->
 			sexpr "%s = (%s)%s" (reg r) (ctype (rtype r)) (reg v)
 		| OArraySize (r,a) ->
 			sexpr "%s = %s->size" (reg r) (reg a)
 		| OType (r,t) ->
-			sexpr "%s = %s" (reg r) (type_value t)
+			sexpr "%s = %s" (reg r) (type_value ctx t)
 		| OGetType (r,v) ->
 			sexpr "%s = %s ? ((vdynamic*)%s)->t : &hlt_void" (reg r) (reg v) (reg v)
 		| OGetTID (r,v) ->
@@ -1048,36 +1071,36 @@ let generate_function ctx f =
 		| OSetref (r,v) ->
 			sexpr "*%s = %s" (reg r) (reg v)
 		| OToVirtual (r,v) ->
-			sexpr "%s = hl_to_virtual(%s,(vdynamic*)%s)" (reg r) (type_value (rtype r)) (reg v)
+			sexpr "%s = hl_to_virtual(%s,(vdynamic*)%s)" (reg r) (type_value ctx (rtype r)) (reg v)
 		| ODynGet (r,o,sid) ->
 			let t = rtype r in
-			let h = hash ctx sid in
+			let h = hash gctx sid in
 			sexpr "%s = (%s)hl_dyn_get%s((vdynamic*)%s,%ld/*%s*/%s)" (reg r) (ctype t) (dyn_prefix t) (reg o) h code.strings.(sid) (type_value_opt t)
 		| ODynSet (o,sid,v) ->
-			let h = hash ctx sid in
+			let h = hash gctx sid in
 			sexpr "hl_dyn_set%s((vdynamic*)%s,%ld/*%s*/%s,%s)" (dyn_prefix (rtype v)) (reg o) h code.strings.(sid) (type_value_opt (rtype v)) (reg v)
 		| OMakeEnum (r,cid,rl) ->
-			let e, et = (match rtype r with HEnum e -> e, enum_constr_type ctx e cid | _ -> Globals.die "" __LOC__) in
+			let e, et = (match rtype r with HEnum e -> e, enum_constr_type gctx ctx e cid | _ -> Globals.die "" __LOC__) in
 			let need_tmp = List.mem r rl in
 			let tmp = if not need_tmp then reg r else begin
 				sexpr "{ venum *tmp";
 				"tmp"
 			end in
-			sexpr "%s = hl_alloc_enum(%s,%d)" tmp (type_value (rtype r)) cid;
+			sexpr "%s = hl_alloc_enum(%s,%d)" tmp (type_value ctx (rtype r)) cid;
 			let _,_,tl = e.efields.(cid) in
 			list_iteri (fun i v ->
 				sexpr "((%s*)%s)->p%d = %s" et tmp i (rcast v tl.(i))
 			) rl;
 			if need_tmp then sexpr "%s = tmp; }" (reg r)
 		| OEnumAlloc (r,cid) ->
-			sexpr "%s = hl_alloc_enum(%s,%d)" (reg r) (type_value (rtype r)) cid
+			sexpr "%s = hl_alloc_enum(%s,%d)" (reg r) (type_value ctx (rtype r)) cid
 		| OEnumIndex (r,v) ->
 			sexpr "%s = HL__ENUM_INDEX__(%s)" (reg r) (reg v)
 		| OEnumField (r,e,cid,pid) ->
-			let tname,(_,_,tl) = (match rtype e with HEnum e -> enum_constr_type ctx e cid, e.efields.(cid) | _ -> Globals.die "" __LOC__) in
+			let tname,(_,_,tl) = (match rtype e with HEnum e -> enum_constr_type gctx ctx e cid, e.efields.(cid) | _ -> Globals.die "" __LOC__) in
 			sexpr "%s((%s*)%s)->p%d" (rassign r tl.(pid)) tname (reg e) pid
 		| OSetEnumField (e,pid,r) ->
-			let tname, (_,_,tl) = (match rtype e with HEnum e -> enum_constr_type ctx e 0, e.efields.(0) | _ -> Globals.die "" __LOC__) in
+			let tname, (_,_,tl) = (match rtype e with HEnum e -> enum_constr_type gctx ctx e 0, e.efields.(0) | _ -> Globals.die "" __LOC__) in
 			sexpr "((%s*)%s)->p%d = (%s)%s" tname (reg e) pid (ctype tl.(pid)) (reg r)
 		| OSwitch (r,idx,eend) ->
 			sline "switch(%s) {" (reg r);
@@ -1397,9 +1420,9 @@ let make_modules ctx all_types =
 	) (List.rev !all_contexts);
 	!all_modules
 
-let generate_module_types ctx m =
+let generate_module_types gctx ctx m =
 	let def_name = "INC_" ^ String.concat "__" (ExtString.String.nsplit m.m_name "/") in
-	let line = line ctx and expr = expr ctx and sexpr fmt = Printf.ksprintf (expr ctx) fmt in
+	let line = linec ctx and expr = exprc ctx and sexpr fmt = Printf.ksprintf (exprc ctx) fmt in
 	let type_name t =
 		match t with
 		| HObj o | HStruct o -> o.pname
@@ -1413,23 +1436,24 @@ let generate_module_types ctx m =
 		match t with
 		| HObj o | HStruct o ->
 			let name = tname o.pname in
+			let td_name = tname ("_" ^ o.pname) in
 			ctx.defined_types <- PMap.add t () ctx.defined_types;
-			define ctx (sprintf "typedef struct _%s *%s;" name name);
+			define ctx (sprintf "typedef struct %s *%s;" td_name name);
 		| _ -> ()
 	) types;
 	line "";
 	List.iter (fun t ->
 		match t with
 		| HObj op | HStruct op ->
-			let name = tname op.pname in
-			line ("struct _" ^ name ^ " {");
+			let name = tname ("_" ^ op.pname) in
+			line ("struct " ^ name ^ " {");
 			block ctx;
 			let rec loop o =
 				(match o.psuper with
 				| None ->
 					if not (is_struct t) then expr ("hl_type *$type");
 				| Some c ->
-					define_type ctx (if is_struct t then HStruct c else HObj c);
+					define_type gctx ctx (if is_struct t then HStruct c else HObj c);
 					loop c);
 				Array.iteri (fun i (n,_,t) ->
 					let rec abs_index p v =
@@ -1437,7 +1461,7 @@ let generate_module_types ctx m =
 						| None -> v
 						| Some o -> abs_index o.psuper (Array.length o.pfields + v)
 					in
-					define_type ctx t;
+					define_type gctx ctx t;
 					expr (var_type (if n = "" then unamed_field (abs_index o.psuper i) else n) t)
 				) o.pfields;
 			in
@@ -1451,11 +1475,11 @@ let generate_module_types ctx m =
 					block ctx;
 					line "HL__ENUM_CONSTRUCT__";
 					Array.iteri (fun i t ->
-						define_type ctx t;
+						define_type gctx ctx t;
 						expr (var_type ("p" ^ string_of_int i) t)
 					) pl;
 					unblock ctx;
-					sexpr "} %s" (enum_constr_type ctx e i);
+					sexpr "} %s" (enum_constr_type gctx ctx e i);
 				end;
 			) e.efields
 		| _ ->
@@ -1464,43 +1488,36 @@ let generate_module_types ctx m =
 	line "#endif";
 	line ""
 
-let write_c com file (code:code) gnames =
+let write_c com file (code:code) gnames num_domains =
 
 	let all_types, htypes = gather_types code in
 	let types_ids = make_types_idents htypes in
 	let gnames = make_global_names code gnames in
 	let bnames = Array.map (fun b -> "bytes$" ^ short_digest (Digest.to_hex (Digest.bytes b))) code.bytes in
-
-	let ctx = {
+	let gctx = {
 		version = com.Gctx.version.version;
-		out = Buffer.create 1024;
-		tabs = "";
 		hlcode = code;
+		hash_mutex = Mutex.create();
 		hash_cache = Hashtbl.create 0;
 		hash_mem = Hashtbl.create 0;
 		hash_cache_list = [];
 		dir = (match Filename.dirname file with "" -> "." | dir -> String.concat "/" (ExtString.String.nsplit dir "\\"));
-		curfile = "";
 		cfiles = [];
 		ftable = make_function_table code;
 		htypes = types_ids;
 		gnames = gnames;
 		bytes_names = bnames;
-		defines = [];
-		hdefines = Hashtbl.create 0;
-		defined_funs = Hashtbl.create 0;
-		defined_types = PMap.empty;
-		file_prefix = "";
-		fun_index = 0;
 		type_module = PMap.empty;
 		gcon = com;
 	} in
-	let modules = make_modules ctx all_types in
+	let modules = make_modules gctx all_types in
+	let native_libs = Hashtbl.create 0 in
 
-	let line = line ctx and expr = expr ctx in
-	let sline fmt = Printf.ksprintf line fmt and sexpr fmt = Printf.ksprintf expr fmt in
+	Path.mkdir_recursive "" (ExtString.String.nsplit (gctx.dir ^ "/hl") "/");
 
-	open_file ctx "hl/natives.h";
+	(
+	let ctx = open_file gctx "hl/natives.h" in
+	let line = linec ctx and sexpr fmt = Printf.ksprintf (exprc ctx) fmt in
 	define ctx "#ifndef HL_NATIVES_H";
 	define ctx "#define HL_NATIVES_H";
 	define ctx "// Abstract decls";
@@ -1514,15 +1531,14 @@ let write_c com file (code:code) gnames =
 	List.iter (fun name -> define ctx (sprintf "typedef struct _%s %s;" name name)) abstracts;
 	define ctx "";
 	line "// Natives functions";
-	let native_libs = Hashtbl.create 0 in
 	let sorted_natives = Array.copy code.natives in
 	Array.sort (fun n1 n2 -> let mk (lib,name,_,_) = code.strings.(lib), code.strings.(name) in compare (mk n1) (mk n2)) sorted_natives;
 	Array.iter (fun (lib,_,_,idx) ->
 		let name = code.strings.(lib) in
 		let name = if name.[0] = '?' then String.sub name 1 (String.length name - 1) else name in
 		Hashtbl.replace native_libs name ();
-		let ft = ctx.ftable.(idx) in
-		define_type ctx (HFun (ft.fe_args,ft.fe_ret));
+		let ft = gctx.ftable.(idx) in
+		define_type gctx ctx (HFun (ft.fe_args,ft.fe_ret));
 		match ft.fe_name with
 		| "hl_tls_get_w" ->
 			define ctx "#define hl_tls_get_w(tls) ((vdynamic*)hl_tls_get(tls))";
@@ -1533,14 +1549,18 @@ let write_c com file (code:code) gnames =
 	) sorted_natives;
 	line "#endif";
 	line "";
+	close_file ctx;
+	);
 
-	open_file ctx "hl/globals.c";
+	(
+	let ctx = open_file gctx "hl/globals.c" in
+	let line = linec ctx and expr = exprc ctx and sline fmt = Printf.ksprintf (linec ctx) fmt and sexpr fmt = Printf.ksprintf (exprc ctx) fmt in
 	define ctx "#define HLC_BOOT";
 	define ctx "#include <hlc.h>";
 	line "// Globals";
 	Array.iteri (fun i t ->
 		let name = gnames.(i) in
-		define_type ctx t;
+		define_type gctx ctx t;
 		sexpr "%s = 0" (var_type name t)
 	) code.globals;
 	Array.iter (fun (g,fields) ->
@@ -1551,14 +1571,14 @@ let write_c com file (code:code) gnames =
 			| HI32 ->
 				Int32.to_string code.ints.(idx)
 			| HBytes ->
-				"(vbyte*)" ^ string ctx idx
+				"(vbyte*)" ^ string gctx ctx idx
 			| _ ->
 				Globals.die "" __LOC__
 		in
 		let fields = match t with
 			| HObj o | HStruct o ->
 				let fields = List.map2 field_value (List.map (fun (_,_,t) -> t) (Array.to_list o.pfields)) (Array.to_list fields) in
-				if is_struct t then fields else type_value ctx t :: fields
+				if is_struct t then fields else type_value gctx ctx t :: fields
 			| _ ->
 				Globals.die "" __LOC__
 		in
@@ -1613,40 +1633,45 @@ let write_c com file (code:code) gnames =
 				output_bytes (output_string ch) (Bytes.to_string bytes);
 				close_out ch;
 			end;
-			sline "vbyte %s[] = {" ctx.bytes_names.(i);
+			sline "vbyte %s[] = {" gctx.bytes_names.(i);
 			output ctx (Printf.sprintf "#%s  include \"%s\"\n" ctx.tabs bytes_file);
 			sexpr "}";
 		end else begin
-			output ctx (Printf.sprintf "vbyte %s[] = {" ctx.bytes_names.(i));
+			output ctx (Printf.sprintf "vbyte %s[] = {" gctx.bytes_names.(i));
 			output_bytes (output ctx) (Bytes.to_string bytes);
 			sexpr "}";
 		end
 	) code.bytes;
+	close_file ctx;
+	save_cfile gctx ctx.curfile;
+	);
 
+	(
+	let ctx = open_file gctx "hl/types.c" in
+	let line = linec ctx and sexpr fmt = Printf.ksprintf (exprc ctx) fmt in
 	let type_value ctx t = "&" ^ type_name ctx t in (* no auto import *)
-	open_file ctx "hl/types.c";
 	define ctx "#define HLC_BOOT";
 	define ctx "#include <hlc.h>";
 	line "// Types values";
 	Array.iteri (fun i t ->
 		match t with
 		| HMethod _ | HFun _ | HVirtual _ ->
-			sexpr "hl_type %s = { %s } /* %s */" (type_name ctx t) (type_id t) (tstr t);
+			sexpr "hl_type %s = { %s } /* %s */" (type_name gctx t) (type_id t) (tstr t);
 		| _ ->
-			sexpr "hl_type %s = { %s }" (type_name ctx t) (type_id t);
+			sexpr "hl_type %s = { %s }" (type_name gctx t) (type_id t);
 	) all_types;
 
 	line "";
 	line "// Types values data";
 	Array.iter (fun t ->
 		let field_value (_,name_id,t) =
-			sprintf "{(const uchar*)%s, %s, %ld}" (string ctx name_id) (type_value ctx t) (hash ctx name_id)
+			sprintf "{(const uchar*)%s, %s, %ld}" (string gctx ctx name_id) (type_value gctx t) (hash gctx name_id)
 		in
 		match t with
 		| HObj o | HStruct o ->
-			let name = type_name ctx t in
+			let name = type_name gctx t in
 			let proto_value p =
-				sprintf "{(const uchar*)%s, %d, %d, %ld}" (string ctx p.fid) p.fmethod (match p.fvirtual with None -> -1 | Some i -> i) (hash ctx p.fid)
+				sprintf "{(const uchar*)%s, %d, %d, %ld}" (string gctx ctx p.fid) p.fmethod (match p.fvirtual with None -> -1 | Some i -> i) (hash gctx p.fid)
 			in
 			let fields =
 				if Array.length o.pfields = 0 then "NULL" else
@@ -1670,29 +1695,29 @@ let write_c com file (code:code) gnames =
 				string_of_int (Array.length o.pfields);
 				string_of_int (Array.length o.pproto);
 				string_of_int (List.length o.pbindings);
-				sprintf "(const uchar*)%s" (string ctx o.pid);
-				(match o.psuper with None -> "NULL" | Some c -> type_value ctx (match t with HObj _ -> HObj c | _ -> HStruct c));
+				sprintf "(const uchar*)%s" (string gctx ctx o.pid);
+				(match o.psuper with None -> "NULL" | Some c -> type_value gctx (match t with HObj _ -> HObj c | _ -> HStruct c));
 				fields;
 				proto;
 				bindings
 			] in
 			sexpr "static hl_type_obj obj%s = {%s}" name (String.concat "," ofields);
 		| HEnum e ->
-			let ename = type_name ctx t in
+			let ename = type_name gctx t in
 			let constr_value cid (name,nid,tl) =
 				let tval = if Array.length tl = 0 then "NULL" else
 					let name = sprintf "econstruct%s_%d" ename cid in
-					sexpr "static hl_type *%s[] = {%s}" name (String.concat "," (List.map (type_value ctx) (Array.to_list tl)));
+					sexpr "static hl_type *%s[] = {%s}" name (String.concat "," (List.map (type_value gctx) (Array.to_list tl)));
 					name
 				in
-				let size = if Array.length tl = 0 then "0" else sprintf "sizeof(%s)" (enum_constr_type ctx e cid) in
+				let size = if Array.length tl = 0 then "0" else sprintf "sizeof(%s)" (enum_constr_type gctx ctx e cid) in
 				let offsets = if Array.length tl = 0 then "NULL" else
 					let name = sprintf "eoffsets%s_%d" ename cid in
 					sexpr "static int %s[] = {%s}" name (String.concat "," (List.map (fun _ -> "0") (Array.to_list tl)));
 					name
 				in
 				let has_ptr = List.exists is_gc_ptr (Array.to_list tl) in
-				sprintf "{(const uchar*)%s, %d, %s, %s, %s, %s}" (string ctx nid) (Array.length tl) tval size (if has_ptr then "true" else "false") offsets
+				sprintf "{(const uchar*)%s, %d, %s, %s, %s, %s}" (string gctx ctx nid) (Array.length tl) tval size (if has_ptr then "true" else "false") offsets
 			in
 			let constr_name = if Array.length e.efields = 0 then "NULL" else begin
 				let name = sprintf "econstruct%s" ename in
@@ -1700,13 +1725,13 @@ let write_c com file (code:code) gnames =
 				name;
 			end in
 			let efields = [
-				if e.eid = 0 then "NULL" else sprintf "(const uchar*)%s" (string ctx e.eid);
+				if e.eid = 0 then "NULL" else sprintf "(const uchar*)%s" (string gctx ctx e.eid);
 				string_of_int (Array.length e.efields);
 				constr_name
 			] in
 			sexpr "static hl_type_enum enum%s = {%s}" ename (String.concat "," efields);
 		| HVirtual v ->
-			let vname = type_name ctx t in
+			let vname = type_name gctx t in
 			let fields_name =
 				if Array.length v.vfields = 0 then "NULL" else
 				let name = sprintf "vfields%s" vname in
@@ -1719,13 +1744,13 @@ let write_c com file (code:code) gnames =
 			] in
 			sexpr "static hl_type_virtual virt%s = {%s}" vname (String.concat "," vfields);
 		| HFun (args,ret) | HMethod(args,ret) ->
-			let fname = type_name ctx t in
+			let fname = type_name gctx t in
 			let aname = if args = [] then "NULL" else
 				let name = sprintf "fargs%s" fname in
-				sexpr "static hl_type *%s[] = {%s}" name (String.concat "," (List.map (type_value ctx) args));
+				sexpr "static hl_type *%s[] = {%s}" name (String.concat "," (List.map (type_value gctx) args));
 				name
 			in
-			sexpr "static hl_type_fun tfun%s = {%s,%s,%d}" fname aname (type_value ctx ret) (List.length args)
+			sexpr "static hl_type_fun tfun%s = {%s,%s,%d}" fname aname (type_value gctx ret) (List.length args)
 		| _ ->
 			()
 	) all_types;
@@ -1739,7 +1764,7 @@ let write_c com file (code:code) gnames =
 	sexpr "fdump(&ntypes,4)";
 	let fcount = ref 0 in
 	Array.iter (fun t ->
-		sexpr "t = &%s; fdump(&t, sizeof(void*))" (type_name ctx t);
+		sexpr "t = &%s; fdump(&t, sizeof(void*))" (type_name gctx t);
 		(match t with
 		| HFun _ -> incr fcount
 		| _ -> ());
@@ -1749,7 +1774,7 @@ let write_c com file (code:code) gnames =
 	Array.iter (fun t ->
 		match t with
 		| HFun _ ->
-			sexpr "t = (hl_type*)&%s.fun->closure_type; fdump(&t, sizeof(void*))" (type_name ctx t);
+			sexpr "t = (hl_type*)&%s.fun->closure_type; fdump(&t, sizeof(void*))" (type_name gctx t);
 		| _ -> ()
 	) all_types;
 	line "#else";
@@ -1764,31 +1789,31 @@ let write_c com file (code:code) gnames =
 	Array.iter (fun t ->
 		match t with
 		| HObj o | HStruct o ->
-			let name = type_name ctx t in
+			let name = type_name gctx t in
 			sexpr "obj%s.m = ctx" name;
 			(match o.pclassglobal with
 			| None -> ()
 			| Some g ->
-				define_global ctx g;
+				define_global gctx ctx g;
 				sexpr "obj%s.global_value = (void**)&%s" name gnames.(g));
 			sexpr "%s.obj = &obj%s" name name
 		| HNull r | HRef r | HPacked r ->
-			sexpr "%s.tparam = %s" (type_name ctx t) (type_value ctx r)
+			sexpr "%s.tparam = %s" (type_name gctx t) (type_value gctx r)
 		| HEnum e ->
-			let name = type_name ctx t in
+			let name = type_name gctx t in
 			sexpr "%s.tenum = &enum%s" name name;
 			(match e.eglobal with
 			| None -> ()
 			| Some g ->
-				define_global ctx g;
+				define_global gctx ctx g;
 				sexpr "enum%s.global_value = (void**)&%s" name gnames.(g));
 			sexpr "hl_init_enum(&%s,ctx)" name;
 		| HVirtual _ ->
-			let name = type_name ctx t in
+			let name = type_name gctx t in
 			sexpr "%s.virt = &virt%s" name name;
 			sexpr "hl_init_virtual(&%s,ctx)" name;
 		| HFun _ | HMethod _ ->
-			let name = type_name ctx t in
+			let name = type_name gctx t in
 			sexpr "%s.fun = &tfun%s" name name
 		| _ ->
 			()
@@ -1796,22 +1821,41 @@ let write_c com file (code:code) gnames =
 	sexpr "hl_gc_set_dump_types(dump_types)";
 	unblock ctx;
 	line "}";
+	close_file ctx;
+	save_cfile gctx ctx.curfile;
+	);
 
-	open_file ctx "hl/reflect.c";
+	(
+	let ctx = open_file gctx "hl/reflect.c" in
+	let line = linec ctx in
 	define ctx "#define HLC_BOOT";
 	define ctx "#include <hlc.h>";
 	line "// Reflection helpers";
-	generate_reflection ctx;
-
-	List.iter (fun m ->
+	generate_reflection gctx ctx;
+	close_file ctx;
+	save_cfile gctx ctx.curfile;
+	);
+
+	(
+	let modules = Array.of_list modules in
+	Array.iter (fun m ->
+		let path = Filename.dirname m.m_name in
+		if not (Sys.file_exists (gctx.dir ^ "/" ^ path)) then
+			Path.mkdir_recursive gctx.dir (ExtString.String.nsplit path "/");
+		(* add cfiles in deterministic order *)
+		if m.m_functions <> [] then save_cfile gctx (m.m_name ^ ".c")
+	) modules;
+	Parallel.run_parallel_for num_domains (Array.length modules) (fun idx ->
+		let m = modules.(idx) in
 		let defined_types = ref PMap.empty in
 		if m.m_types <> [] then begin
-			open_file ctx (m.m_name ^ ".h");
-			generate_module_types ctx m;
+			let ctx = open_file gctx (m.m_name ^ ".h") in
+			generate_module_types gctx ctx m;
 			defined_types := ctx.defined_types;
+			close_file ctx;
 		end;
 		if m.m_functions <> [] then begin
-			open_file ctx (m.m_name ^ ".c");
+			let ctx = open_file gctx (m.m_name ^ ".c") in
 			ctx.defined_types <- !defined_types;
 			define ctx "#define HLC_BOOT";
 			define ctx "#include <hlc.h>";
@@ -1825,47 +1869,61 @@ let write_c com file (code:code) gnames =
 					("",0)
 			in
 			let funcs = List.sort (fun f1 f2 -> compare (file_pos f1) (file_pos f2)) m.m_functions in
-			List.iter (fun fe -> match fe.fe_decl with None -> () | Some f -> generate_function ctx f) funcs;
+			List.iter (fun fe -> match fe.fe_decl with None -> () | Some f -> generate_function gctx ctx f) funcs;
+			close_file ctx;
 		end;
-	) modules;
+	);
+	);
 
-	open_file ctx "hl/functions.c";
+	(
+	let ctx = open_file gctx "hl/functions.c" in
+	let line = linec ctx and sexpr fmt = Printf.ksprintf (exprc ctx) fmt in
 	define ctx "#define HLC_BOOT";
 	define ctx "#include <hlc.h>";
 	sexpr "void *hl_functions_ptrs[] = {%s}" (String.concat ",\\\n\t" (List.map (fun f ->
-		let name = define_function ctx f.fe_index in
+		let name = define_function gctx ctx f.fe_index in
 		if name = "hl_tls_get_w" then "hl_tls_get" else name
-	) (Array.to_list ctx.ftable)));
+	) (Array.to_list gctx.ftable)));
 	let rec loop i =
-		if i = Array.length ctx.ftable then [] else
-		let ft = ctx.ftable.(i) in
-		let n = type_name ctx (HFun (ft.fe_args,ft.fe_ret)) in
+		if i = Array.length gctx.ftable then [] else
+		let ft = gctx.ftable.(i) in
+		let n = type_name gctx (HFun (ft.fe_args,ft.fe_ret)) in
 		define ctx (sprintf "extern hl_type %s;" n);
 		("&" ^ n) :: loop (i + 1)
 	in
 	sexpr "hl_type *hl_functions_types[] = {%s}" (String.concat ",\\\n\t" (loop 0));
 	line "";
 	Array.iter (fun f ->
-		if f.fe_module = None then (match f.fe_decl with None -> () | Some f -> generate_function ctx f);
-	) ctx.ftable;
-
-	open_file ctx "hl/hashes.c";
+		if f.fe_module = None then (match f.fe_decl with None -> () | Some f -> generate_function gctx ctx f);
+	) gctx.ftable;
+	close_file ctx;
+	save_cfile gctx ctx.curfile;
+	);
+
+	(
+	let ctx = open_file gctx "hl/hashes.c" in
+	let line = linec ctx and sexpr fmt = Printf.ksprintf (exprc ctx) fmt in
 	define ctx "#define HLC_BOOT";
 	define ctx "#include <hlc.h>";
 	line "";
 	line "void hl_init_hashes() {";
 	block ctx;
-	List.iter (fun i -> sexpr "hl_hash((vbyte*)%s)" (string ctx i)) (List.rev ctx.hash_cache_list);
+	List.iter (fun i -> sexpr "hl_hash((vbyte*)%s)" (string gctx ctx i)) (List.rev gctx.hash_cache_list);
 	unblock ctx;
 	line "}";
+	close_file ctx;
+	save_cfile gctx ctx.curfile;
+	);
 
-	open_file ctx (Filename.basename file);
+	(
+	let ctx = open_file gctx (Filename.basename file) in
+	let line = linec ctx and expr = exprc ctx and sline fmt = Printf.ksprintf (linec ctx) fmt and sexpr fmt = Printf.ksprintf (exprc ctx) fmt in
 	define ctx "#define HLC_BOOT";
 	define ctx "#include <hlc.h>";
 	line "#include <hlc_main.c>";
 	line "";
 	line "#ifndef HL_MAKE";
-	List.iter (sline "#  include <%s>") ctx.cfiles;
+	List.iter (sline "#  include <%s>") gctx.cfiles;
 	line "#endif";
 	line "";
 	expr "void hl_init_hashes()";
@@ -1884,16 +1942,20 @@ let write_c com file (code:code) gnames =
 	expr "hl_init_types(&ctx)";
 	expr "hl_init_hashes()";
 	expr "hl_init_roots()";
-	if code.entrypoint >= 0 then sexpr "%s()" (define_function ctx code.entrypoint);
+	if code.entrypoint >= 0 then sexpr "%s()" (define_function gctx ctx code.entrypoint);
 	unblock ctx;
 	line "}";
 	line "";
+	close_file ctx;
+	save_cfile gctx ctx.curfile;
+	);
 
-	open_file ctx "hlc.json";
-
+	(
+	let ctx = open_file gctx "hlc.json" in
+	let line = linec ctx and sline fmt = Printf.ksprintf (linec ctx) fmt in
 	line "{";
 	block ctx;
-	sline "\"version\" : %d," ctx.version;
+	sline "\"version\" : %d," gctx.version;
 	sline "\"libs\" : [%s]," (String.concat "," (Hashtbl.fold (fun k _ acc -> sprintf "\"%s\"" k :: acc) native_libs []));
 	let defines = Buffer.create 64 in
 	PMap.iter (fun key value ->
@@ -1901,8 +1963,8 @@ let write_c com file (code:code) gnames =
 	) com.defines.values;
 	Buffer.truncate defines (Buffer.length defines - 1);
 	sline "\"defines\" : {%s\n\t}," (Buffer.contents defines);
-	sline "\"files\" : [%s\n\t]" (String.concat "," (List.map (sprintf "\n\t\t\"%s\"") ctx.cfiles));
+	sline "\"files\" : [%s\n\t]" (String.concat "," (List.map (sprintf "\n\t\t\"%s\"") gctx.cfiles));
 	unblock ctx;
 	line "}";
-
-	close_file ctx
+	close_file ctx;
+	);

+ 1 - 0
src/generators/hlcode.ml

@@ -213,6 +213,7 @@ type fundecl = {
 	code : opcode array;
 	debug : (int * int * Globals.pos) array;
 	assigns : (string index * int) array;
+	need_opt : bool;
 }
 
 type code = {

+ 8 - 7
src/generators/hlopt.ml

@@ -547,7 +547,8 @@ let remap_fun ctx f dump get_str old_code =
 	let nregs = Array.length f.regs in
 	let reg_remap = ctx.r_used_regs <> nregs in
 	let assigns = ref f.assigns in
-	let write str = match dump with None -> () | Some ch -> IO.nwrite ch (Bytes.unsafe_of_string (str ^ "\n")) in
+	let dump_buffer = if dump then Buffer.create 1024 else Buffer.create 0  in
+	let write str = if dump then Buffer.add_string dump_buffer (str ^ "\n") else () in
 	let nargs = (match f.ftype with HFun (args,_) -> List.length args | _ -> Globals.die "" __LOC__) in
 
 	let live_bits = ctx.r_live_bits in
@@ -620,7 +621,7 @@ let remap_fun ctx f dump get_str old_code =
 	end;
 
 	(* done *)
-	if dump <> None then begin
+	if dump then begin
 		let old_assigns = Hashtbl.create 0 in
 		let new_assigns = Hashtbl.create 0 in
 		Array.iter (fun (var,pos) -> if pos >= 0 then Hashtbl.replace old_assigns pos var) f.assigns;
@@ -672,7 +673,6 @@ let remap_fun ctx f dump get_str old_code =
 		loop 0 ctx.r_root;
 		write "";
 		write "";
-		(match dump with None -> () | Some ch -> IO.flush ch);
 	end;
 
 	let code = ref f.code in
@@ -739,7 +739,8 @@ let remap_fun ctx f dump get_str old_code =
 			regs := new_regs;
 		end;
 	end;
-	{ f with code = !code; regs = !regs; debug = !debug; assigns = !assigns }
+	let dump_str = Buffer.contents dump_buffer in
+	({ f with code = !code; regs = !regs; debug = !debug; assigns = !assigns }, dump_str)
 
 let _optimize (f:fundecl) =
 	let nregs = Array.length f.regs in
@@ -1059,8 +1060,8 @@ type cache_elt = {
 let opt_cache = ref PMap.empty
 let used_mark = ref 0
 
-let optimize dump get_str (f:fundecl) (hxf:Type.tfunc) =
-	let old_code = match dump with None -> f.code | Some _ -> Array.copy f.code in
+let optimize dump get_str (f:fundecl) (hxf:string) =
+	let old_code = if dump then Array.copy f.code else f.code in
 	try
 		let c = PMap.find hxf (!opt_cache) in
 		c.c_last_used <- !used_mark;
@@ -1095,7 +1096,7 @@ let optimize dump get_str (f:fundecl) (hxf:Type.tfunc) =
 		let fopt = remap_fun rctx f dump get_str old_code in
 		Hashtbl.iter (fun _ b ->
 			b.bstate <- None;
-			if dump = None then begin
+			if not dump then begin
 				b.bneed <- ISet.empty;
 				b.bneed_all <- None;
 			end;

+ 7 - 0
src/generators/jvm/jvmClass.ml

@@ -40,6 +40,7 @@ class builder path_this path_super = object(self)
 	val methods = DynArray.create ()
 	val method_sigs = Hashtbl.create 0
 	val inner_classes = Hashtbl.create 0
+	val typed_function_paths = Hashtbl.create 0
 	val closure_ids_per_name = Hashtbl.create 0
 	val mutable spawned_methods = []
 	val mutable static_init_method = None
@@ -117,6 +118,12 @@ class builder path_this path_super = object(self)
 		end;
 		jc
 
+	method add_typed_function (path : jpath) =
+		Hashtbl.add typed_function_paths path ()
+
+	method has_typed_function (path : jpath) =
+		Hashtbl.mem typed_function_paths path
+
 	method spawn_method (name : string) (jsig_method : jsignature) (flags : MethodAccessFlags.t list) =
 		let jm = new JvmMethod.builder self name jsig_method in
 		let ssig_method = generate_method_signature false jsig_method in

+ 20 - 14
src/generators/jvm/jvmFunctions.ml

@@ -64,6 +64,7 @@ let declassify = function
 	| CObject -> object_path_sig object_path
 
 class typed_functions = object(self)
+	val signature_mutex = Mutex.create ()
 	val signatures = Hashtbl.create 0
 	val mutable max_arity = 0
 
@@ -80,10 +81,27 @@ class typed_functions = object(self)
 		(cl : signature_classification list)
 		(cr : signature_classification option)
 	=
-		try
+		Mutex.lock signature_mutex;
+		let meth = try
 			Hashtbl.find signatures (cl,cr)
 		with Not_found ->
 			self#do_register_signature cl cr
+		in
+		Mutex.unlock signature_mutex;
+		(* If the method has something that's not java.lang.Object, the next method is one where all arguments are
+		   of type java.lang.Object. *)
+		   if meth.has_nonobject then begin
+			let meth_objects = self#objectify meth in
+			meth.next <- Some meth_objects;
+		(* Otherwise, if the method has a return type that's not java.lang.Object, the next method is one that returns
+		   java.lang.Object. *)
+		end else begin match cr with
+			| Some CObject ->
+				()
+			| _ ->
+				meth.next <- Some (self#get_signature meth.cargs (Some CObject))
+		end;
+		meth
 
 	method private do_register_signature
 		(cl : signature_classification list)
@@ -107,19 +125,6 @@ class typed_functions = object(self)
 		} in
 		if meth.arity > max_arity then max_arity <- meth.arity;
 		Hashtbl.add signatures (meth.cargs,meth.cret) meth;
-		(* If the method has something that's not java.lang.Object, the next method is one where all arguments are
-		   of type java.lang.Object. *)
-		if meth.has_nonobject then begin
-			let meth_objects = self#objectify meth in
-			meth.next <- Some meth_objects;
-		(* Otherwise, if the method has a return type that's not java.lang.Object, the next method is one that returns
-		   java.lang.Object. *)
-		end else begin match cr with
-			| Some CObject ->
-				()
-			| _ ->
-				meth.next <- Some (self#get_signature meth.cargs (Some CObject))
-		end;
 		meth
 
 	method make_forward_method_jsig
@@ -341,6 +346,7 @@ class typed_function
 				Printf.sprintf "%s_%s" (snd path) (patch_name name)
 		in
 		let jc = host_class#spawn_inner_class None haxe_function_path (Some name) in
+		jc#add_typed_function jc#get_this_path;
 		jc#add_access_flag 0x10; (* final *)
 		jc
 

+ 11 - 10
src/macro/eval/evalContext.ml

@@ -34,9 +34,9 @@ type scope = {
 	(* The local start offset of the current scope. *)
 	local_offset : int;
 	(* The locals declared in the current scope. Maps variable IDs to local slots. *)
-	locals : (int,int) Hashtbl.t;
+	locals : int IntHashtbl.t;
 	(* The name of local variables. Maps local slots to variable names. Only filled in debug mode. *)
-	local_infos : (int,var_info) Hashtbl.t;
+	local_infos : var_info IntHashtbl.t;
 	(* The IDs of local variables. Maps variable names to variable IDs. *)
 	local_ids : (string,int) Hashtbl.t;
 }
@@ -59,7 +59,7 @@ type env_info = {
 	(* The environment kind. *)
 	kind : env_kind;
 	(* The name of capture variables. Maps local slots to variable names. Only filled in debug mode. *)
-	capture_infos : (int,var_info) Hashtbl.t;
+	capture_infos : var_info IntHashtbl.t;
 	(* The number of local variables. *)
 	num_locals : int;
 	(* The number of capture variables. *)
@@ -114,7 +114,7 @@ and eval = {
 	(* The currently active breakpoint. Set to a dummy value initially. *)
 	mutable breakpoint : breakpoint;
 	(* Map of all types that are currently being caught. Updated by `emit_try`. *)
-	caught_types : (int,bool) Hashtbl.t;
+	caught_types : bool IntHashtbl.t;
 	(* The most recently caught exception. Used by `debug_loop` to avoid getting stuck. *)
 	mutable caught_exception : value;
 	(* The value which was last returned. *)
@@ -156,8 +156,8 @@ type function_breakpoint = {
 type builtins = {
 	mutable instance_builtins : (int * value) list IntMap.t;
 	mutable static_builtins : (int * value) list IntMap.t;
-	constructor_builtins : (int,value list -> value) Hashtbl.t;
-	empty_constructor_builtins : (int,unit -> value) Hashtbl.t;
+	constructor_builtins : (value list -> value) IntHashtbl.t;
+	empty_constructor_builtins : (unit -> value) IntHashtbl.t;
 }
 
 type debug_scope_info = {
@@ -168,7 +168,7 @@ type debug_scope_info = {
 type context_reference =
 	| StackFrame of env
 	| Scope of scope * env
-	| CaptureScope of (int,var_info) Hashtbl.t * env
+	| CaptureScope of var_info IntHashtbl.t * env
 	| DebugScope of debug_scope_info * env
 	| Value of value * env
 	| Toplevel
@@ -249,7 +249,7 @@ and debug_socket = {
 (* Per-context debug information *)
 and debug = {
 	(* The registered breakpoints *)
-	breakpoints : (int,(int,breakpoint) Hashtbl.t) Hashtbl.t;
+	breakpoints : breakpoint IntHashtbl.t IntHashtbl.t;
 	(* The registered function breakpoints *)
 	function_breakpoints : ((int * int),function_breakpoint) Hashtbl.t;
 	(* Whether or not debugging is supported. Has various effects on the amount of
@@ -273,6 +273,7 @@ and context = {
 	mutable curapi : value MacroApi.compiler_api;
 	mutable type_cache : Type.module_type IntMap.t;
 	overrides : (Globals.path * string,bool) Hashtbl.t;
+	timer_ctx : Timer.timer_context;
 	(* prototypes *)
 	mutable array_prototype : vprototype;
 	mutable string_prototype : vprototype;
@@ -435,7 +436,7 @@ let create_env_info static pfile pfile_key kind capture_infos num_locals num_cap
 let push_environment ctx info =
 	let eval = get_eval ctx in
 	let timer = if ctx.detail_times then
-		Timer.timer ["macro";"execution";kind_name eval info.kind]
+		Timer.start_timer ctx.timer_ctx ["macro";"execution";kind_name eval info.kind]
 	else
 		no_timer
 	in
@@ -519,7 +520,7 @@ let get_instance_constructor ctx path p =
 	with Not_found -> Error.raise_typing_error (Printf.sprintf "[%i] Instance constructor not found: %s" ctx.ctx_id (rev_hash path)) p
 
 let get_special_instance_constructor_raise ctx path =
-	Hashtbl.find (get_ctx()).builtins.constructor_builtins path
+	IntHashtbl.find (get_ctx()).builtins.constructor_builtins path
 
 let get_proto_field_index_raise proto name =
 	IntMap.find name proto.pnames

+ 4 - 3
src/macro/eval/evalDebug.ml

@@ -1,3 +1,4 @@
+open Globals
 open Type
 open EvalJitContext
 open EvalContext
@@ -7,7 +8,7 @@ open EvalDebugMisc
 
 let is_caught eval v =
 	try
-		Hashtbl.iter (fun path _ -> if is v path then raise Exit) eval.caught_types;
+		IntHashtbl.iter (fun path _ -> if is v path then raise Exit) eval.caught_types;
 		false
 	with Exit ->
 		true
@@ -72,8 +73,8 @@ let debug_loop jit conn e f =
 	let rec run_check_breakpoint env =
 		let eval = env.env_eval in
 		try
-			let h = Hashtbl.find ctx.debug.breakpoints env.env_info.pfile_unique in
-			let breakpoint = Hashtbl.find h env.env_debug.line in
+			let h = IntHashtbl.find ctx.debug.breakpoints env.env_info.pfile_unique in
+			let breakpoint = IntHashtbl.find h env.env_debug.line in
 			begin match breakpoint.bpstate with
 				| BPEnabled when column_matches breakpoint && condition_holds env breakpoint ->
 					breakpoint.bpstate <- BPHit;

+ 14 - 14
src/macro/eval/evalDebugMisc.ml

@@ -38,27 +38,27 @@ let make_function_breakpoint state =
 	}
 
 let iter_breakpoints ctx f =
-	Hashtbl.iter (fun _ breakpoints ->
-		Hashtbl.iter (fun _ breakpoint -> f breakpoint) breakpoints
+	IntHashtbl.iter (fun _ breakpoints ->
+		IntHashtbl.iter (fun _ breakpoint -> f breakpoint) breakpoints
 	) ctx.debug.breakpoints
 
 let add_breakpoint ctx file line column condition =
 	let hash = hash (Path.UniqueKey.to_string (ctx.file_keys#get (Common.find_file (ctx.curapi.get_com()) file))) in
 	let h = try
-		Hashtbl.find ctx.debug.breakpoints hash
+		IntHashtbl.find ctx.debug.breakpoints hash
 	with Not_found ->
-		let h = Hashtbl.create 0 in
-		Hashtbl.add ctx.debug.breakpoints hash h;
+		let h = IntHashtbl.create 0 in
+		IntHashtbl.add ctx.debug.breakpoints hash h;
 		h
 	in
 	let breakpoint = make_breakpoint hash line BPEnabled column condition in
-	Hashtbl.replace h line breakpoint;
+	IntHashtbl.replace h line breakpoint;
 	breakpoint
 
 let delete_breakpoint ctx file line =
 	let hash = hash (Path.UniqueKey.to_string (ctx.file_keys#get (Common.find_file (ctx.curapi.get_com()) file))) in
-	let h = Hashtbl.find ctx.debug.breakpoints hash in
-	Hashtbl.remove h line
+	let h = IntHashtbl.find ctx.debug.breakpoints hash in
+	IntHashtbl.remove h line
 
 let find_breakpoint ctx sid =
 	let found = ref None in
@@ -78,10 +78,10 @@ let find_breakpoint ctx sid =
 
 exception Parse_expr_error of string
 
-let parse_expr ctx s p =
+let parse_expr ctx config s p =
 	let error s = raise (Parse_expr_error s) in
-	match ParserEntry.parse_expr_string (ctx.curapi.get_com()).Common.defines s p error true with
-	| ParseSuccess(data,_,_) -> data
+	match ParserEntry.parse_expr_string config s p error true with
+	| ParseSuccess(data,_) -> data
 	| ParseError(_,(msg,_),_) -> error (Parser.error_msg msg)
 
 (* Vars *)
@@ -91,8 +91,8 @@ let get_var_slot_by_name env is_read scopes name =
 		| scope :: scopes ->
 			begin try
 				let id = Hashtbl.find scope.local_ids name in
-				let slot = Hashtbl.find scope.locals id in
-				let vi = Hashtbl.find scope.local_infos slot in
+				let slot = IntHashtbl.find scope.locals id in
+				let vi = IntHashtbl.find scope.local_infos slot in
 				if is_read && not (declared_before vi env.env_debug.debug_pos) then raise Not_found;
 				slot + scope.local_offset
 			with Not_found ->
@@ -106,7 +106,7 @@ let get_var_slot_by_name env is_read scopes name =
 let get_capture_slot_by_name capture_infos name =
 	let ret = ref None in
 	try
-		Hashtbl.iter (fun slot vi ->
+		IntHashtbl.iter (fun slot vi ->
 			if name = vi.vi_name then begin
 				ret := (Some slot);
 				raise Exit

+ 24 - 21
src/macro/eval/evalDebugSocket.ml

@@ -225,7 +225,7 @@ let output_scopes ctx env =
 		JObject fl
 	in
 	let scopes = List.fold_left (fun acc scope ->
-		if Hashtbl.length scope.local_infos <> 0 then
+		if IntHashtbl.length scope.local_infos <> 0 then
 			(mk_scope (ctx.debug.debug_context#add_scope scope env) "Locals" scope.pos) :: acc
 		else
 			acc
@@ -240,11 +240,11 @@ let output_scopes ctx env =
 		(mk_scope (ctx.debug.debug_context#add_debug_scope dbg env) "Eval" null_pos) :: scopes
 	end in
 	let scopes = List.rev scopes in
-	let scopes = if Hashtbl.length capture_infos = 0 then scopes else (mk_scope (ctx.debug.debug_context#add_capture_scope capture_infos env) "Captures" null_pos) :: scopes in
+	let scopes = if IntHashtbl.length capture_infos = 0 then scopes else (mk_scope (ctx.debug.debug_context#add_capture_scope capture_infos env) "Captures" null_pos) :: scopes in
 	JArray scopes
 
 let output_capture_vars infos env =
-	let vars = Hashtbl.fold (fun slot vi acc ->
+	let vars = IntHashtbl.fold (fun slot vi acc ->
 		let value = (env.env_captures.(slot)) in
 		(var_to_json vi.vi_name value (Some vi) env) :: acc
 	) infos [] in
@@ -259,7 +259,7 @@ let output_debug_scope dbg env =
 
 let output_scope_vars env scope =
 	let p = env.env_debug.debug_pos in
-	let vars = Hashtbl.fold (fun local_slot vi acc ->
+	let vars = IntHashtbl.fold (fun local_slot vi acc ->
 		if declared_before vi p then begin
 			let slot = local_slot + scope.local_offset in
 			let value = env.env_locals.(slot) in
@@ -312,7 +312,7 @@ let output_inner_vars v env =
 				n, v
 			) l
 		| VInstance {ikind = IStringMap h} ->
-			StringHashtbl.fold (fun s (_,v) acc ->
+			RuntimeStringHashtbl.fold (fun s (_,v) acc ->
 				(s,v) :: acc
 			) h []
 		| VInstance {ikind = IMutex mutex} ->
@@ -384,7 +384,7 @@ module ValueCompletion = struct
 		in
 		loop env.env_debug.scopes;
 		(* 2. Captures *)
-		Hashtbl.iter (fun slot vi ->
+		IntHashtbl.iter (fun slot vi ->
 			add (hash vi.vi_name) "variable"
 		) env.env_info.capture_infos;
 		(* 3. Instance *)
@@ -475,18 +475,18 @@ module ValueCompletion = struct
 	let get_completion ctx text column env =
 		let p = file_pos "" in
 		let save =
-			let old = !Parser.display_mode,DisplayPosition.display_position#get in
+			let old = DisplayPosition.display_position#get in
 			(fun () ->
-				Parser.display_mode := fst old;
-				DisplayPosition.display_position#set (snd old);
+				DisplayPosition.display_position#set old;
 			)
 		in
-		Parser.display_mode := DMDefault;
+		let com = (ctx.curapi.get_com()) in
+		let config = Parser.create_config com.Common.defines true true DMDefault com.parser_state.was_auto_triggered None in
 		let offset = column + (String.length "class X{static function main() ") - 1 (* this is retarded *) in
 		DisplayPosition.display_position#set {p with pmin = offset; pmax = offset};
 		begin try
-			let e = parse_expr ctx text p in
-			let e = ExprPreprocessing.find_before_pos DMDefault e in
+			let e = parse_expr ctx config text p in
+			let e = ExprPreprocessing.find_before_pos com.parser_state.was_auto_triggered DMDefault e in
 			save();
 			let rec loop e = match fst e with
 			| EDisplay(e1,DKDot) ->
@@ -542,6 +542,9 @@ let expect_env hctx env = match env with
 	| None -> hctx.send_error "No frame found"
 
 let handler =
+	let parse_expr ctx p =
+		parse_expr ctx (ParserConfig.default_config (ctx.curapi.get_com()).Common.defines) p
+	in
 	let parse_breakpoint hctx jo =
 		let j = hctx.jsonrpc in
 		let obj = j#get_object "breakpoint" jo in
@@ -644,17 +647,17 @@ let handler =
 			let hash = hash (Path.UniqueKey.to_string (hctx.ctx.file_keys#get (Common.find_file (hctx.ctx.curapi.get_com()) file))) in
 			let h =
 				try
-					let h = Hashtbl.find hctx.ctx.debug.breakpoints hash in
-					Hashtbl.clear h;
+					let h = IntHashtbl.find hctx.ctx.debug.breakpoints hash in
+					IntHashtbl.clear h;
 					h
 				with Not_found ->
-					let h = Hashtbl.create (List.length bps) in
-					Hashtbl.add hctx.ctx.debug.breakpoints hash h;
+					let h = IntHashtbl.create (List.length bps) in
+					IntHashtbl.add hctx.ctx.debug.breakpoints hash h;
 					h
 			in
 			let bps = List.map (fun (line,column,condition) ->
 				let bp = make_breakpoint hash line BPEnabled column condition in
-				Hashtbl.add h line bp;
+				IntHashtbl.add h line bp;
 				JObject ["id",JInt bp.bpid]
 			) bps in
 			JArray bps
@@ -685,10 +688,10 @@ let handler =
 		"removeBreakpoint",(fun hctx ->
 			let id = hctx.jsonrpc#get_int_param "id" in
 			begin try
-				Hashtbl.iter (fun _ h ->
+				IntHashtbl.iter (fun _ h ->
 					let to_delete = ref [] in
-					Hashtbl.iter (fun k breakpoint -> if breakpoint.bpid = id then to_delete := k :: !to_delete) h;
-					List.iter (fun k -> Hashtbl.remove h k) !to_delete;
+					IntHashtbl.iter (fun k breakpoint -> if breakpoint.bpid = id then to_delete := k :: !to_delete) h;
+					List.iter (fun k -> IntHashtbl.remove h k) !to_delete;
 				) hctx.ctx.debug.breakpoints;
 			with Not_found ->
 				hctx.send_error (Printf.sprintf "Unknown breakpoint: %d" id)
@@ -726,7 +729,7 @@ let handler =
 			| Scope(scope,env) ->
 				let value = get_value env in
 				let id = Hashtbl.find scope.local_ids name in
-				let slot = Hashtbl.find scope.locals id in
+				let slot = IntHashtbl.find scope.locals id in
 				env.env_locals.(slot + scope.local_offset) <- value;
 				var_to_json "" value None env
 			| CaptureScope(infos,env) ->

+ 2 - 2
src/macro/eval/evalEmitter.ml

@@ -219,10 +219,10 @@ let emit_try exec catches env =
 	let ctx = get_ctx() in
 	let eval = env.env_eval in
 	if ctx.debug.support_debugger then begin
-		List.iter (fun (_,path,_) -> Hashtbl.add eval.caught_types path true) catches
+		List.iter (fun (_,path,_) -> IntHashtbl.add eval.caught_types path true) catches
 	end;
 	let restore () =
-		List.iter (fun (_,path,_) -> Hashtbl.remove eval.caught_types path) catches
+		List.iter (fun (_,path,_) -> IntHashtbl.remove eval.caught_types path) catches
 	in
 	let v = try
 		let v = handle_stack_overflow eval (fun() -> exec env) in

+ 2 - 2
src/macro/eval/evalEncode.ml

@@ -249,8 +249,8 @@ let encode_object_map_direct =
 	create_cached_instance key_haxe_ds_ObjectMap (fun (s : value ValueHashtbl.t) -> IObjectMap (Obj.magic s))
 
 let encode_string_map convert m =
-	let h = StringHashtbl.create () in
-	PMap.iter (fun key value -> StringHashtbl.add h (create_ascii key) (convert value)) m;
+	let h = RuntimeStringHashtbl.create () in
+	PMap.iter (fun key value -> RuntimeStringHashtbl.add h (create_ascii key) (convert value)) m;
 	encode_string_map_direct h
 
 let fake_proto path =

+ 4 - 4
src/macro/eval/evalJit.ml

@@ -229,13 +229,13 @@ and jit_expr jit return e =
 		let fl,exec = jit_tfunction jit_closure true e.epos tf in
 		let hasret = jit_closure.has_nonfinal_return in
 		let eci = get_env_creation jit_closure false tf.tf_expr.epos.pfile (EKLocalFunction jit.num_closures) in
-		let captures = Hashtbl.fold (fun vid (i,declared) acc -> (i,vid,declared) :: acc) jit_closure.captures [] in
+		let captures = IntHashtbl.fold (fun vid (i,declared) acc -> (i,vid,declared) :: acc) jit_closure.captures [] in
 		let captures = List.sort (fun (i1,_,_) (i2,_,_) -> Stdlib.compare i1 i2) captures in
 		(* Check if the out-of-scope var is in the outer scope because otherwise we have to promote outwards. *)
 		List.iter (fun var -> ignore(get_capture_slot jit var)) jit_closure.captures_outside_scope;
 		let captures = ExtList.List.filter_map (fun (i,vid,declared) ->
 			if declared then None
-			else Some (i,fst (try Hashtbl.find jit.captures vid with Not_found -> Error.raise_typing_error (Printf.sprintf "Could not find capture variable %i" vid) e.epos))
+			else Some (i,fst (try IntHashtbl.find jit.captures vid with Not_found -> Error.raise_typing_error (Printf.sprintf "Could not find capture variable %i" vid) e.epos))
 		) captures in
 		let mapping = Array.of_list captures in
 		emit_closure ctx mapping eci hasret exec fl
@@ -696,10 +696,10 @@ and jit_tfunction jit static pos tf =
 	fl,exec
 
 and get_env_creation jit static file info =
-	create_env_info static file (jit.ctx.file_keys#get file) info jit.capture_infos jit.max_num_locals (Hashtbl.length jit.captures)
+	create_env_info static file (jit.ctx.file_keys#get file) info jit.capture_infos jit.max_num_locals (IntHashtbl.length jit.captures)
 
 let jit_timer ctx f =
-	Std.finally (Timer.timer [(if ctx.is_macro then "macro" else "interp");"jit"]) f ()
+	Timer.time ctx.timer_ctx [(if ctx.is_macro then "macro" else "interp");"jit"] f ()
 
 (* Creates a [EvalValue.vfunc] of function [tf], which can be [static] or not. *)
 let jit_tfunction ctx key_type key_field tf static pos =

部分文件因为文件数量过多而无法显示