소스 검색

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

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

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

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

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

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

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

+ 1 - 0
haxe.opam

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

+ 43 - 8
src-json/define.json

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

+ 33 - 12
src/codegen/dump.ml

@@ -2,6 +2,9 @@ open Globals
 open Common
 open Common
 open Type
 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
 	Make a dump of the full typed AST of all types
 *)
 *)
@@ -13,13 +16,21 @@ let create_dumpfile acc l =
 		close_out ch)
 		close_out ch)
 
 
 let create_dumpfile_from_path com path =
 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
 	buf,close
 
 
 let dump_types com pretty =
 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_type = s_type (Type.print_context()) in
 	let s_expr,s_type_param = if not pretty then
 	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
 	else
 		(Type.s_expr_pretty false "\t" true),(s_type_param s_type)
 		(Type.s_expr_pretty false "\t" true),(s_type_param s_type)
 	in
 	in
@@ -27,7 +38,7 @@ let dump_types com pretty =
 		| [] -> ""
 		| [] -> ""
 		| l -> Printf.sprintf "<%s>" (String.concat ", " (List.map s_type_param l))
 		| l -> Printf.sprintf "<%s>" (String.concat ", " (List.map s_type_param l))
 	in
 	in
-	List.iter (fun mt ->
+	let f mt =
 		let path = Type.t_path mt in
 		let path = Type.t_path mt in
 		let buf,close = create_dumpfile_from_path com path 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
 		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 -> " from " ^ s_type t) a.a_from))
 			(String.concat " " (List.map (fun t -> " to " ^ s_type t) a.a_to));
 			(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 =
 let dump_record com =
-	List.iter (fun mt ->
+	let f mt =
 		let buf,close = create_dumpfile_from_path com (t_path mt) in
 		let buf,close = create_dumpfile_from_path com (t_path mt) in
 		let s = match mt with
 		let s = match mt with
 			| TClassDecl c -> Printer.s_tclass "" c
 			| TClassDecl c -> Printer.s_tclass "" c
@@ -130,11 +145,14 @@ let dump_record com =
 			| TAbstractDecl a -> Printer.s_tabstract "" a
 			| TAbstractDecl a -> Printer.s_tabstract "" a
 		in
 		in
 		Buffer.add_string buf s;
 		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 =
 let dump_position com =
-	List.iter (fun mt ->
+	let f mt =
 		match mt with
 		match mt with
 			| TClassDecl c ->
 			| TClassDecl c ->
 				let buf,close = create_dumpfile_from_path com (t_path mt) in
 				let buf,close = create_dumpfile_from_path com (t_path mt) in
@@ -153,7 +171,10 @@ let dump_position com =
 				close();
 				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 =
 let dump_types com =
 	match Common.defined_value_safe com Define.Dump with
 	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
 		| None -> platform_name_macro com
 		| Some s -> s
 		| Some s -> s
 	in
 	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 buf,close = create_dumpfile [] dump_dependencies_path in
 	let print fmt = Printf.kprintf (fun s -> Buffer.add_string buf s) fmt in
 	let print fmt = Printf.kprintf (fun s -> Buffer.add_string buf s) fmt in
 	let dep = Hashtbl.create 0 in
 	let dep = Hashtbl.create 0 in
@@ -190,7 +211,7 @@ let dump_dependencies ?(target_override=None) com =
 		) m.m_extra.m_deps;
 		) m.m_extra.m_deps;
 	) com.Common.modules;
 	) com.Common.modules;
 	close();
 	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 buf,close = create_dumpfile [] dump_dependants_path in
 	let print fmt = Printf.kprintf (fun s -> Buffer.add_string buf s) fmt in
 	let print fmt = Printf.kprintf (fun s -> Buffer.add_string buf s) fmt in
 	Hashtbl.iter (fun n ml ->
 	Hashtbl.iter (fun n ml ->

+ 16 - 13
src/codegen/genxml.ml

@@ -212,7 +212,7 @@ let rec exists f c =
 			| None -> false
 			| None -> false
 			| Some (csup,_) -> exists f csup
 			| 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
 	let m = (t_infos t).mt_module in
 	match t with
 	match t with
 	| TClassDecl c ->
 	| 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 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 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 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
 		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)
 		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
 		IO.printf ch "<![CDATA[%s]]>" s
 
 
 let generate com file =
 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
 	let ch = IO.output_string() in
 	write_xml ch "" x;
 	write_xml ch "" x;
 	IO.close_out ch
 	IO.close_out ch

+ 26 - 25
src/codegen/javaModern.ml

@@ -1018,7 +1018,7 @@ module Converter = struct
 		(pack,types)
 		(pack,types)
 end
 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
 	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 loaded = false
 	val mutable closed = 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 =
 	method load =
 		if not loaded then begin
 		if not loaded then begin
 			loaded <- true;
 			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
 		end
 
 
 	method private read zip (filename,entry) =
 	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 data = Zip.read_entry zip entry in
 			let jc = JReaderModern.parse_class (IO.input_string data) in
 			let jc = JReaderModern.parse_class (IO.input_string data) in
 			(jc,file_path,file_path ^ "@" ^ filename)
 			(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;
 					if entries = [] then raise Not_found;
 					let zip = Lazy.force zip in
 					let zip = Lazy.force zip in
 					let jcs = List.map (self#read zip) entries 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)
 						Some (Converter.convert_module (fst path) jcs)
 					) ();
 					) ();
 				with Not_found ->
 				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)])
 	(path.tpackage, [(EClass class_data,pos)])
 
 
 let extract_data (_,tags) =
 let extract_data (_,tags) =
-	let t = Timer.timer ["read";"swf"] in
 	let h = Hashtbl.create 0 in
 	let h = Hashtbl.create 0 in
 	let loop_field f =
 	let loop_field f =
 		match f.hlf_kind with
 		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)
 			List.iter (fun i -> Array.iter loop_field i.hls_fields) (As3hlparse.parse as3)
 		| _ -> ()
 		| _ -> ()
 	) tags;
 	) tags;
-	t();
 	h
 	h
 
 
+let extract_data com arg =
+	Timer.time com.timer_ctx ["read";"swf"] extract_data arg
+
 let remove_debug_infos as3 =
 let remove_debug_infos as3 =
 	let hl = As3hlparse.parse as3 in
 	let hl = As3hlparse.parse as3 in
 	let methods = Hashtbl.create 0 in
 	let methods = Hashtbl.create 0 in
@@ -547,8 +548,7 @@ let remove_debug_infos as3 =
 	in
 	in
 	As3hlparse.flatten (List.map loop_static hl)
 	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 is_swc = Path.file_extension file = "swc" || Path.file_extension file = "ane" in
 	let ch = if is_swc then begin
 	let ch = if is_swc then begin
 		let zip = Zip.open_in file in
 		let zip = Zip.open_in file in
@@ -577,9 +577,11 @@ let parse_swf com file =
 			t.tdata <- TActionScript3 (id,remove_debug_infos as3)
 			t.tdata <- TActionScript3 (id,remove_debug_infos as3)
 		| _ -> ()
 		| _ -> ()
 	) tags;
 	) tags;
-	t();
 	(h,tags)
 	(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)
 class swf_library com name file_path = object(self)
 	inherit [swf_lib_type,Swf.swf] native_library name file_path
 	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
 	method extract = match swf_classes with
 		| None ->
 		| None ->
-			let d = extract_data self#get_swf in
+			let d = extract_data com self#get_swf in
 			swf_classes <- Some d;
 			swf_classes <- Some d;
 			d
 			d
 		| Some d ->
 		| Some d ->

+ 8 - 5
src/compiler/args.ml

@@ -64,6 +64,7 @@ let parse_args com =
 		raise_usage = (fun () -> ());
 		raise_usage = (fun () -> ());
 		display_arg = None;
 		display_arg = None;
 		deprecations = [];
 		deprecations = [];
+		measure_times = false;
 	} in
 	} in
 	let add_deprecation s =
 	let add_deprecation s =
 		actx.deprecations <- s :: actx.deprecations
 		actx.deprecations <- s :: actx.deprecations
@@ -104,9 +105,9 @@ let parse_args com =
 		),"<name[=path]>","generate code for a custom target");
 		),"<name[=path]>","generate code for a custom target");
 		("Target",[],["-x"], Arg.String (fun cl ->
 		("Target",[],["-x"], Arg.String (fun cl ->
 			let cpath = Path.parse_type_path cl in
 			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")
 				| 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;
 			actx.classes <- cpath :: actx.classes;
 			Common.define com Define.Interp;
 			Common.define com Define.Interp;
 			set_platform com Eval "";
 			set_platform com Eval "";
@@ -131,9 +132,9 @@ let parse_args com =
 			actx.hxb_libs <- lib :: actx.hxb_libs
 			actx.hxb_libs <- lib :: actx.hxb_libs
 		),"<path>","add a hxb library");
 		),"<path>","add a hxb library");
 		("Compilation",["-m";"--main"],["-main"],Arg.String (fun cl ->
 		("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
 			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
 			actx.classes <- cpath :: actx.classes
 		),"<class>","select startup class");
 		),"<class>","select startup class");
 		("Compilation",["-L";"--library"],["-lib"],Arg.String (fun _ -> ()),"<name[:ver]>","use a haxelib library");
 		("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;
 			actx.hxb_out <- Some file;
 		),"<file>", "generate haxe binary representation to target archive");
 		),"<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");
 		("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 () ->
 		("Optimization",["--no-inline"],[],Arg.Unit (fun () ->
 			add_deprecation "--no-inline has been deprecated, use -D no-inline instead";
 			add_deprecation "--no-inline has been deprecated, use -D no-inline instead";
 			Common.define com Define.NoInline
 			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 modules : (path,module_def) Hashtbl.t = Hashtbl.create 0
 	val binary_cache : (path,HxbData.module_cache) 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 tmp_binary_cache : (path,HxbData.module_cache) Hashtbl.t = Hashtbl.create 0
-	val string_pool  = StringPool.create ()
 	val removed_files = Hashtbl.create 0
 	val removed_files = Hashtbl.create 0
 	val mutable json = JNull
 	val mutable json = JNull
 	val mutable initialized = false
 	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
 		try (Hashtbl.find modules path).m_extra
 		with Not_found -> (self#get_hxb_module path).mc_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
 		match m.m_extra.m_kind with
 		| MImport ->
 		| 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 =
 	method cache_module_in_memory path m =
 		Hashtbl.replace modules 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_modules = modules
 
 
 	method get_hxb = binary_cache
 	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 *)
 	(* TODO handle hxb cache there too *)
 	method get_removed_files = removed_files
 	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 private virtual execute : unit
 
 
 	method run : 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_priority = priority
 	method get_id = id
 	method get_id = id

+ 3 - 1
src/compiler/compilationContext.ml

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

+ 56 - 47
src/compiler/compiler.ml

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

+ 7 - 8
src/compiler/displayOutput.ml

@@ -1,7 +1,6 @@
 open Globals
 open Globals
 open Ast
 open Ast
 open Common
 open Common
-open Timer
 open DisplayTypes.DisplayMode
 open DisplayTypes.DisplayMode
 open DisplayTypes.CompletionResultKind
 open DisplayTypes.CompletionResultKind
 open CompletionItem
 open CompletionItem
@@ -24,14 +23,15 @@ let htmlescape s =
 	let s = String.concat "&quot;" (ExtString.String.nsplit s "\"") in
 	let s = String.concat "&quot;" (ExtString.String.nsplit s "\"") in
 	s
 	s
 
 
-let get_timer_fields start_time =
+let get_timer_fields timer_ctx =
+	let open Timer in
 	let tot = ref 0. 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
 	if !tot > 0. then
 		Hashtbl.fold (fun _ t acc ->
 		Hashtbl.fold (fun _ t acc ->
 			((String.concat "." t.id),(Printf.sprintf "%.3fs (%.0f%%)" t.total (t.total *. 100. /. !tot))) :: 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
 	else
 		fields
 		fields
 
 
@@ -272,11 +272,10 @@ let handle_display_exception_old ctx dex = match dex with
 		raise (Completion (String.concat "." pack))
 		raise (Completion (String.concat "." pack))
 	| DisplayFields r ->
 	| DisplayFields r ->
 		DisplayPosition.display_position#reset;
 		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) ->
 			(List.map (fun (name,value) ->
 				CompletionItem.make_ci_timer ("@TIME " ^ 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
 		end else
 			r.fitems
 			r.fitems
 		in
 		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 file_unique = com.file_keys#get file in
 		let pos, smode = try ExtString.String.split pos "@" with _ -> pos,"" in
 		let pos, smode = try ExtString.String.split pos "@" with _ -> pos,"" in
 		let create mode =
 		let create mode =
-			Parser.display_mode := mode;
 			DisplayTypes.DisplayMode.create mode
 			DisplayTypes.DisplayMode.create mode
 		in
 		in
 		let dm = match smode with
 		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
 		if String.length input > 0 && (input.[0] = '[' || input.[0] = '{') then begin
 			actx.did_something <- true;
 			actx.did_something <- true;
 			actx.force_typing <- true;
 			actx.force_typing <- true;
-			DisplayJson.parse_input ctx.com input Timer.measure_times
+			DisplayJson.parse_input ctx.com input
 		end else
 		end else
 			handle_display_argument_old ctx.com input actx;
 			handle_display_argument_old ctx.com input actx;
 	| None ->
 	| None ->
@@ -103,17 +102,6 @@ let process_display_configuration ctx =
 			| WMDisable ->
 			| 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
 	end
 
 
 let process_display_file com actx =
 let process_display_file com actx =
@@ -143,7 +131,7 @@ let process_display_file com actx =
 			DPKNone
 			DPKNone
 		| DFPOnly when (DisplayPosition.display_position#get).pfile = file_input_marker ->
 		| DFPOnly when (DisplayPosition.display_position#get).pfile = file_input_marker ->
 			actx.classes <- [];
 			actx.classes <- [];
-			com.main.main_class <- None;
+			com.main.main_path <- None;
 			begin match com.file_contents with
 			begin match com.file_contents with
 			| [_, Some input] ->
 			| [_, Some input] ->
 				com.file_contents <- [];
 				com.file_contents <- [];
@@ -154,7 +142,7 @@ let process_display_file com actx =
 		| dfp ->
 		| dfp ->
 			if dfp = DFPOnly then begin
 			if dfp = DFPOnly then begin
 				actx.classes <- [];
 				actx.classes <- [];
-				com.main.main_class <- None;
+				com.main.main_path <- None;
 			end;
 			end;
 			let dpk = List.map (fun file_key ->
 			let dpk = List.map (fun file_key ->
 				let real = Path.get_real_path (Path.UniqueKey.to_string file_key) in
 				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 handle_display_after_typing ctx tctx display_file_dot_path =
 	let com = ctx.com in
 	let com = ctx.com in
 	if ctx.com.display.dms_kind = DMNone && ctx.has_error then raise Abort;
 	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
 		| DMDefault,Some(kind,subj) -> DisplayOutput.handle_syntax_completion com kind subj
 		| _ -> ()
 		| _ -> ()
 	end;
 	end;
@@ -315,9 +303,9 @@ let process_global_display_mode com tctx =
 	promote_type_hints tctx;
 	promote_type_hints tctx;
 	match com.display.dms_kind with
 	match com.display.dms_kind with
 	| DMUsage (with_definition,_,_) ->
 	| DMUsage (with_definition,_,_) ->
-		FindReferences.find_references tctx com with_definition
+		FindReferences.find_references com with_definition
 	| DMImplementation ->
 	| DMImplementation ->
-		FindReferences.find_implementations tctx com
+		FindReferences.find_implementations com
 	| DMModuleSymbols filter ->
 	| DMModuleSymbols filter ->
 		let open CompilationCache in
 		let open CompilationCache in
 		let cs = com.cs in
 		let cs = com.cs in
@@ -359,7 +347,7 @@ let handle_display_after_finalization ctx tctx display_file_dot_path =
 	| RMDiagnostics _ ->
 	| RMDiagnostics _ ->
 		DisplayOutput.emit_diagnostics com
 		DisplayOutput.emit_diagnostics com
 	| RMStatistics ->
 	| RMStatistics ->
-		DisplayOutput.emit_statistics tctx
+		DisplayOutput.emit_statistics com
 	| RMNone ->
 	| RMNone ->
 		()
 		()
 	end
 	end

+ 33 - 37
src/compiler/generate.ml

@@ -18,20 +18,20 @@ let check_auxiliary_output com actx =
 		| Some file ->
 		| Some file ->
 			Common.log com ("Generating json : " ^ file);
 			Common.log com ("Generating json : " ^ file);
 			Path.mkdir_from_path file;
 			Path.mkdir_from_path file;
-			Genjson.generate com.types file
+			Genjson.generate com.timer_ctx com.types file
 	end
 	end
 
 
-let create_writer com config string_pool =
+let create_writer com config =
 	let anon_identification = new tanon_identification in
 	let anon_identification = new tanon_identification in
 	let warn w s p = com.Common.warning w com.warning_options s p 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 () ->
 	writer,(fun () ->
 		let out = IO.output_string () in
 		let out = IO.output_string () in
 		HxbWriter.export writer out;
 		HxbWriter.export writer out;
 		IO.close_out 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
 	let open HxbData in
 	match m.m_extra.m_kind with
 	match m.m_extra.m_kind with
 		| MCode | MMacro | MFake | MExtern -> begin
 		| 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
 					IO.nwrite out data
 				) hxb_cache.mc_chunks;
 				) hxb_cache.mc_chunks;
 				let data = IO.close_out out in
 				let data = IO.close_out out in
-				zip#add_entry data path;
+				Some (path,data)
 			end else begin
 			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;
 				HxbWriter.write_module writer m;
 				let bytes = close () in
 				let bytes = close () in
-				zip#add_entry bytes path;
+				Some (path,bytes)
 			end
 			end
 		end
 		end
 	| _ ->
 	| _ ->
-		()
+		None
 
 
 let check_hxb_output ctx config =
 let check_hxb_output ctx config =
 	let open HxbWriterConfig in
 	let open HxbWriterConfig in
 	let com = ctx.com 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 =
 	let match_path_list l sl_path =
 		List.exists (fun sl -> Ast.match_path true sl_path sl) l
 		List.exists (fun sl -> Ast.match_path true sl_path sl) l
 	in
 	in
 	let try_write from_cache =
 	let try_write from_cache =
 		let path = config.HxbWriterConfig.archive_path in
 		let path = config.HxbWriterConfig.archive_path in
 		let path = Str.global_replace (Str.regexp "\\$target") (platform_name ctx.com.platform) 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;
 		Path.mkdir_from_path path;
 		let zip = new Zip_output.zip_output path 6 in
 		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 cc = CommonCache.get_cache com in
 			let target = Common.platform_name_macro 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
 				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
 				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
 		in
 		Std.finally (fun () ->
 		Std.finally (fun () ->
 			zip#close;
 			zip#close;
 			t()
 			t()
 		) (fun () ->
 		) (fun () ->
-			let string_pool = if config.share_string_pool then Some (StringPool.create ()) else None in
 			if config.target_config.generate then begin
 			if config.target_config.generate then begin
-				export com config.target_config string_pool;
+				export com config.target_config
 			end;
 			end;
 
 
 			if config.macro_config.generate then begin
 			if config.macro_config.generate then begin
 				match com.get_macros() with
 				match com.get_macros() with
 					| Some mcom ->
 					| 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;
 			end;
-
-			if config.share_string_pool then
-				write_string_pool config.target_config zip "StringPool.hxb" (Option.get string_pool);
 		) ()
 		) ()
 	in
 	in
 	try
 	try
@@ -135,8 +131,10 @@ let delete_file f = try Sys.remove f with _ -> ()
 let maybe_generate_dump ctx tctx =
 let maybe_generate_dump ctx tctx =
 	let com = tctx.Typecore.com in
 	let com = tctx.Typecore.com in
 	if Common.defined com Define.Dump then begin
 	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;
 	end;
 	if Common.defined com Define.DumpDependencies then begin
 	if Common.defined com Define.DumpDependencies then begin
 		Dump.dump_dependencies com;
 		Dump.dump_dependencies com;
@@ -158,7 +156,7 @@ let generate ctx tctx ext actx =
 		| _ -> Path.mkdir_from_path com.file
 		| _ -> Path.mkdir_from_path com.file
 	end;
 	end;
 	if actx.interp then begin
 	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
 		let old = tctx.com.args in
 		tctx.com.args <- ctx.runtime_args;
 		tctx.com.args <- ctx.runtime_args;
 		let restore () =
 		let restore () =
@@ -200,8 +198,6 @@ let generate ctx tctx ext actx =
 		if name = "" then ()
 		if name = "" then ()
 		else begin
 		else begin
 			Common.log com ("Generating " ^ name ^ ": " ^ com.file);
 			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
 	end
 	end

+ 2 - 3
src/compiler/haxe.ml

@@ -43,12 +43,11 @@
 *)
 *)
 open Server
 open Server
 
 
-let other = Timer.timer ["other"];;
+;;
 Sys.catch_break true;
 Sys.catch_break true;
 
 
 let args = List.tl (Array.to_list Sys.argv) in
 let args = List.tl (Array.to_list Sys.argv) in
 set_binary_mode_out stdout true;
 set_binary_mode_out stdout true;
 set_binary_mode_out stderr true;
 set_binary_mode_out stderr true;
 let sctx = ServerCompilationContext.create false in
 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 is_debug_run = try Sys.getenv "HAXEDEBUG" = "1" with _ -> false
 
 
-let start_time = ref (Timer.get_time())
-
 let prompt = ref false
 let prompt = ref false
 
 
 let expand_env ?(h=None) path  =
 let expand_env ?(h=None) path  =

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

@@ -2,7 +2,7 @@ open Globals
 open Common
 open Common
 open ExtString
 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
 	inherit abstract_hxb_lib
 	val zip = lazy (Zip.open_in file_path)
 	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 string_pool : string array option = None
 	val mutable macro_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 =
 	method load =
 		if not loaded then begin
 		if not loaded then begin
 			loaded <- true;
 			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
 		end
 
 
 	method get_bytes (target : string) (path : path) =
 	method get_bytes (target : string) (path : path) =
 		try
 		try
 			let path = (target :: fst path,snd path) in
 			let path = (target :: fst path,snd path) in
 			let (filename,entry) = Hashtbl.find modules 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)
 			Some (Bytes.unsafe_of_string data)
 		with Not_found ->
 		with Not_found ->
 			None
 			None
@@ -74,4 +66,4 @@ let create_hxb_lib com file_path =
 	with Not_found ->
 	with Not_found ->
 		failwith ("hxb lib " ^ file_path ^ " not found")
 		failwith ("hxb lib " ^ file_path ^ " not found")
 	in
 	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
 class hxb_reader
 	(mpath : path)
 	(mpath : path)
 	(stats : hxb_reader_stats)
 	(stats : hxb_reader_stats)
-	(string_pool : string array option)
-	(timers_enabled : bool)
+	(timer_ctx : Timer.timer_context option)
 = object(self)
 = object(self)
 	val mutable api = Obj.magic ""
 	val mutable api = Obj.magic ""
 	val mutable full_restore = true
 	val mutable full_restore = true
 	val mutable current_module = null_module
 	val mutable current_module = null_module
 
 
 	val mutable ch = BytesWithPosition.create (Bytes.create 0)
 	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 doc_pool = Array.make 0 ""
 
 
 	val mutable classes = Array.make 0 (Lazy.from_val null_class)
 	val mutable classes = Array.make 0 (Lazy.from_val null_class)
@@ -190,12 +188,6 @@ class hxb_reader
 			dump_backtrace();
 			dump_backtrace();
 			error (Printf.sprintf "[HXB] [%s] Cannot resolve type %s" (s_type_path current_module.m_path) (s_type_path ((pack @ [mname]),tname)))
 			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 =
 	method make_lazy_type_dynamic f : Type.t =
 		api#make_lazy_type t_dynamic f
 		api#make_lazy_type t_dynamic f
 
 
@@ -2015,11 +2007,9 @@ class hxb_reader
 		match kind with
 		match kind with
 		| STR ->
 		| STR ->
 			string_pool <- self#read_string_pool;
 			string_pool <- self#read_string_pool;
-			has_string_pool <- true;
 		| DOC ->
 		| DOC ->
 			doc_pool <- self#read_string_pool;
 			doc_pool <- self#read_string_pool;
 		| MDF ->
 		| MDF ->
-			assert(has_string_pool);
 			current_module <- self#read_mdf;
 			current_module <- self#read_mdf;
 			incr stats.modules_partially_restored;
 			incr stats.modules_partially_restored;
 			if not full_restore then current_module.m_extra.m_display_deps <- Some PMap.empty
 			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 =
 	method private read_chunk_data kind =
 		let path = String.concat "_" (ExtLib.String.nsplit (s_type_path mpath) ".") in
 		let path = String.concat "_" (ExtLib.String.nsplit (s_type_path mpath) ".") in
 		let id = ["hxb";"read";string_of_chunk_kind kind;path] 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
 		try
 			self#read_chunk_data' kind
 			self#read_chunk_data' kind
 		with Invalid_argument msg -> begin
 		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
 	| NegBits,Postfix -> 10
 	| Spread,Postfix -> 11
 	| 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
 module Pool = struct
 	type ('key,'value) t = {
 	type ('key,'value) t = {
 		lut : ('key,int) Hashtbl.t;
 		lut : ('key,int) Hashtbl.t;
@@ -408,9 +397,9 @@ type hxb_writer = {
 	config : HxbWriterConfig.writer_target_config;
 	config : HxbWriterConfig.writer_target_config;
 	warn : Warning.warning -> string -> Globals.pos -> unit;
 	warn : Warning.warning -> string -> Globals.pos -> unit;
 	anon_id : Type.t Tanon_identification.tanon_identification;
 	anon_id : Type.t Tanon_identification.tanon_identification;
+	identified_anons : (tanon,int) IdentityPool.t;
 	mutable current_module : module_def;
 	mutable current_module : module_def;
 	chunks : Chunk.t DynArray.t;
 	chunks : Chunk.t DynArray.t;
-	has_own_string_pool : bool;
 	cp : StringPool.t;
 	cp : StringPool.t;
 	docs : StringPool.t;
 	docs : StringPool.t;
 	mutable chunk : Chunk.t;
 	mutable chunk : Chunk.t;
@@ -1017,26 +1006,33 @@ module HxbWriter = struct
 		end
 		end
 
 
 	and write_anon_ref writer (an : tanon) =
 	and write_anon_ref writer (an : tanon) =
-		let pfm = Option.get (writer.anon_id#identify_anon ~strict:true an) in
 		try
 		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_u8 writer.chunk 0;
 			Chunk.write_uleb128 writer.chunk index
 			Chunk.write_uleb128 writer.chunk index
 		with Not_found ->
 		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_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 =
 	and write_anon_field_ref writer cf =
 		try
 		try
@@ -2257,10 +2253,8 @@ module HxbWriter = struct
 		start_chunk writer EOF;
 		start_chunk writer EOF;
 		start_chunk writer EOM;
 		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
 		begin
 			let a = StringPool.finalize writer.docs in
 			let a = StringPool.finalize writer.docs in
 			if a.length > 0 then
 			if a.length > 0 then
@@ -2275,21 +2269,16 @@ module HxbWriter = struct
 		l
 		l
 end
 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;
 		config;
 		warn;
 		warn;
 		anon_id;
 		anon_id;
+		identified_anons = IdentityPool.create();
 		current_module = null_module;
 		current_module = null_module;
 		chunks = DynArray.create ();
 		chunks = DynArray.create ();
 		cp = cp;
 		cp = cp;
-		has_own_string_pool;
 		docs = StringPool.create ();
 		docs = StringPool.create ();
 		chunk = Obj.magic ();
 		chunk = Obj.magic ();
 		classes = Pool.create ();
 		classes = Pool.create ();

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

@@ -11,7 +11,6 @@ type writer_target_config = {
 
 
 type t = {
 type t = {
 	mutable archive_path : string;
 	mutable archive_path : string;
-	mutable share_string_pool : bool;
 	target_config : writer_target_config;
 	target_config : writer_target_config;
 	macro_config : writer_target_config;
 	macro_config : writer_target_config;
 }
 }
@@ -26,7 +25,6 @@ let create_target_config () = {
 
 
 let create () = {
 let create () = {
 	archive_path = "";
 	archive_path = "";
-	share_string_pool = true; (* Do we want this as default? *)
 	target_config = create_target_config ();
 	target_config = create_target_config ();
 	macro_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;
 	previous = None;
 }
 }
 
 
-let compiler_pretty_message_string com ectx cm =
+let compiler_pretty_message_string defines ectx cm =
 	match cm.cm_message with
 	match cm.cm_message with
 	(* Filter some messages that don't add much when using this message renderer *)
 	(* Filter some messages that don't add much when using this message renderer *)
 	| "End of overload failure reasons" -> None
 	| "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 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_reset = if no_color then "" else "\x1b[0m" in
 		let c_bold = if no_color then "" else "\x1b[1m" in
 		let c_bold = if no_color then "" else "\x1b[1m" in
 		let c_dim = if no_color then "" else "\x1b[2m" 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
 		else max_lines
 	) max_lines messages
 	) 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 ectx = create_error_context absolute_positions in
 	let msg = make_compiler_message "" p 0 MessageKind.DKCompilerMessage MessageSeverity.Information in
 	let msg = make_compiler_message "" p 0 MessageKind.DKCompilerMessage MessageSeverity.Information in
 	ectx.max_lines <- get_max_line ectx.max_lines [msg];
 	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 -> ()
 		| None -> ()
 		| Some s -> prerr_endline s
 		| Some s -> prerr_endline s
 
 
 exception ConfigError of string
 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
 	match format_mode with
-		| "pretty" -> compiler_pretty_message_string com
+		| "pretty" -> compiler_pretty_message_string defines
 		| "indent" -> compiler_indented_message_string
 		| "indent" -> compiler_indented_message_string
 		| "classic" -> compiler_message_string
 		| "classic" -> compiler_message_string
 		| m -> begin
 		| m -> begin
@@ -345,11 +345,11 @@ let print_error (err : Error.error) =
 	) err;
 	) err;
 	!ret
 	!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
 	let ectx = create_error_context absolute_positions in
 	ectx.max_lines <- get_max_line ectx.max_lines messages;
 	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 (
 	let lines = List.rev (
 		List.fold_left (fun lines cm -> match (message_formatter ectx cm) with
 		List.fold_left (fun lines cm -> match (message_formatter ectx cm) with
 			| None -> lines
 			| None -> lines
@@ -369,14 +369,14 @@ let display_messages ctx on_message = begin
 	in
 	in
 
 
 	let get_formatter _ def default =
 	let get_formatter _ def default =
-		try get_formatter ctx.com def default
+		try get_formatter ctx.com.defines def default
 		with | ConfigError s ->
 		with | ConfigError s ->
 			error s;
 			error s;
 			compiler_message_string
 			compiler_message_string
 	in
 	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_messages = ref (Define.defined ctx.com.defines Define.MessageLogFile) in
 	let log_message = ref None in
 	let log_message = ref None in

+ 24 - 37
src/compiler/server.ml

@@ -1,7 +1,6 @@
 open Globals
 open Globals
 open Common
 open Common
 open CompilationCache
 open CompilationCache
-open Timer
 open Type
 open Type
 open DisplayProcessingGlobals
 open DisplayProcessingGlobals
 open Ipaddr
 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
 		TypeloadParse.parse_file_from_string com file p stdin
 	| _ ->
 	| _ ->
 		let ftime = file_time ffile in
 		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
 			try
 				let cfile = cc#find_file fkey in
 				let cfile = cc#find_file fkey in
 				if cfile.c_time <> ftime then raise Not_found;
 				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 ->
 			with Not_found ->
 				let parse_result = TypeloadParse.parse_file com rfile p in
 				let parse_result = TypeloadParse.parse_file com rfile p in
 				let info,is_unusual = match parse_result with
 				let info,is_unusual = match parse_result with
 					| ParseError(_,_,_) -> "not cached, has parse error",true
 					| ParseError(_,_,_) -> "not cached, has parse error",true
-					| ParseSuccess(data,is_display_file,pdi) ->
+					| ParseSuccess(data,pdi) ->
 						if is_display_file then begin
 						if is_display_file then begin
 							if pdi.pd_errors <> [] then
 							if pdi.pd_errors <> [] then
 								"not cached, is display file with parse errors",true
 								"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
 							(* 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. *)
 							checks. The reasoning is that non-display mode has more information than display mode. *)
 							if com.display.dms_full_typing then raise Not_found;
 							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
 							Printf.sprintf "not cached, using \"%s\" define" ident,true
 						with Not_found ->
 						with Not_found ->
 							cc#cache_file fkey (ClassPaths.create_resolved_file ffile rfile.class_path) ftime data pdi;
 							cc#cache_file fkey (ClassPaths.create_resolved_file ffile rfile.class_path) ftime data pdi;
@@ -113,10 +112,9 @@ module Communication = struct
 				end;
 				end;
 				flush stdout;
 				flush stdout;
 			);
 			);
-			exit = (fun code ->
+			exit = (fun timer_ctx code ->
 				if code = 0 then begin
 				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;
 				end;
 				exit code;
 				exit code;
 			);
 			);
@@ -141,15 +139,13 @@ module Communication = struct
 
 
 					sctx.was_compilation <- ctx.com.display.dms_full_typing;
 					sctx.was_compilation <- ctx.com.display.dms_full_typing;
 					if has_error ctx then begin
 					if has_error ctx then begin
-						measure_times := false;
+						ctx.timer_ctx.measure_times <- No;
 						write "\x02\n"
 						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;
 			is_server = true;
@@ -163,7 +159,6 @@ let stat dir =
 
 
 (* Gets a list of changed directories for the current compilation. *)
 (* Gets a list of changed directories for the current compilation. *)
 let get_changed_directories sctx com =
 let get_changed_directories sctx com =
-	let t = Timer.timer ["server";"module cache";"changed dirs"] in
 	let cs = sctx.cs in
 	let cs = sctx.cs in
 	let sign = Define.get_signature com.defines in
 	let sign = Define.get_signature com.defines in
 	let dirs = try
 	let dirs = try
@@ -223,9 +218,11 @@ let get_changed_directories sctx com =
 		Hashtbl.add sctx.changed_directories sign dirs;
 		Hashtbl.add sctx.changed_directories sign dirs;
 		dirs
 		dirs
 	in
 	in
-	t();
 	dirs
 	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 =
 let full_typing com m_extra =
 	com.is_macro_context
 	com.is_macro_context
 	|| com.display.dms_full_typing
 	|| com.display.dms_full_typing
@@ -298,7 +295,7 @@ let check_module sctx com m_path m_extra p =
 				end
 				end
 		in
 		in
 		let has_policy policy = List.mem policy m_extra.m_check_policy || match policy with
 		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
 			| _ -> false
 		in
 		in
 		let check_file () =
 		let check_file () =
@@ -438,14 +435,12 @@ class hxb_reader_api_server
 		| GoodModule m ->
 		| GoodModule m ->
 			m
 			m
 		| BinaryModule mc ->
 		| 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 full_restore = full_typing com mc.mc_extra in
 			let f_next chunks until =
 			let f_next chunks until =
 				let macro = if com.is_macro_context then " (macro)" else "" in
 				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
 			in
 
 
 			let m,chunks = f_next mc.mc_chunks EOT 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
 (* 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. *)
    determine if it's still valid. If this function returns None, the module is re-typed. *)
 and type_module sctx com delay mpath p =
 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 cc = CommonCache.get_cache com in
 	let skip m_path reason =
 	let skip m_path reason =
 		ServerMessage.skipping_dep com "" (m_path,(Printer.s_module_skip_reason reason));
 		ServerMessage.skipping_dep com "" (m_path,(Printer.s_module_skip_reason reason));
 		BadModule reason
 		BadModule reason
 	in
 	in
 	let add_modules from_binary m =
 	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
 		GoodModule m
 	in
 	in
 	let check_module sctx m_path m_extra p =
 	let check_module sctx m_path m_extra p =
-		let tcheck = Timer.timer ["server";"module cache";"check"] in
-		let r = check_module sctx 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
 	in
 	let find_module_in_cache cc m_path p =
 	let find_module_in_cache cc m_path p =
 		try
 		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. *)
 			   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
 			begin match check_module sctx mpath mc.mc_extra p with
 				| None ->
 				| 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 full_restore = full_typing com mc.mc_extra in
 					let api = match com.hxb_reader_api with
 					let api = match com.hxb_reader_api with
 						| Some api ->
 						| Some api ->
@@ -594,10 +584,7 @@ and type_module sctx com delay mpath p =
 					in
 					in
 					let f_next chunks until =
 					let f_next chunks until =
 						let macro = if com.is_macro_context then " (macro)" else "" in
 						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
 					in
 
 
 					let m,chunks = f_next mc.mc_chunks EOT 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
 	TypeloadParse.parse_hook := parse_file sctx.cs
 
 
 let rec process sctx comm args =
 let rec process sctx comm args =
-	let t0 = get_time() in
+	let t0 = Extc.time() in
 	ServerMessage.arguments args;
 	ServerMessage.arguments args;
 	reset sctx;
 	reset sctx;
 	let api = {
 	let api = {
@@ -808,7 +795,7 @@ let rec process sctx comm args =
 	} in
 	} in
 	Compiler.HighLevel.entry api comm args;
 	Compiler.HighLevel.entry api comm args;
 	run_delays sctx;
 	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
 (* The server main loop. Waits for the [accept] call to then process the sent compilation
    parameters through [process_params]. *)
    parameters through [process_params]. *)

+ 2 - 10
src/compiler/serverCompilationContext.ml

@@ -1,5 +1,4 @@
 open Common
 open Common
-open Timer
 open CompilationCache
 open CompilationCache
 
 
 type t = {
 type t = {
@@ -45,22 +44,15 @@ let reset sctx =
 	Hashtbl.clear sctx.changed_directories;
 	Hashtbl.clear sctx.changed_directories;
 	sctx.was_compilation <- false;
 	sctx.was_compilation <- false;
 	Parser.reset_state();
 	Parser.reset_state();
-	Lexer.cur := Lexer.make_file "";
-	measure_times := false;
 	Hashtbl.clear DeprecationCheck.warned_positions;
 	Hashtbl.clear DeprecationCheck.warned_positions;
-	close_times();
 	stats.s_files_parsed := 0;
 	stats.s_files_parsed := 0;
 	stats.s_classes_built := 0;
 	stats.s_classes_built := 0;
 	stats.s_methods_typed := 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 =
 let maybe_cache_context sctx com =
 	if com.display.dms_full_typing && com.display.dms_populate_cache then begin
 	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);
 		ServerMessage.cached_modules com "" (List.length com.modules);
 	end
 	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
 	inherit server_task ["gc"] 100
 
 
 	method private execute =
 	method private execute =
-		let t0 = Timer.get_time() in
+		let t0 = Extc.time() in
 		let stats = Gc.stat() in
 		let stats = Gc.stat() in
 		let live_words = float_of_int stats.live_words 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. *)
 		(* 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();
 			Gc.full_major();
 		end;
 		end;
 		Gc.set old_gc;
 		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
 end
 
 
 class class_maintenance_task (cs : CompilationCache.t) (c : tclass) = object(self)
 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 cast_stack = new_rec_stack()
 
 
+
 let rec make_static_call ctx c cf a pl args t p =
 let rec make_static_call ctx c cf a pl args t p =
 	if cf.cf_kind = Method MethMacro then begin
 	if cf.cf_kind = Method MethMacro then begin
 		match args with
 		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 =
 and cast_or_unify_raise ctx ?(uctx=None) tleft eright p =
 	let uctx = match uctx with
 	let uctx = match uctx with
-		| None -> default_unification_context
+		| None -> default_unification_context ()
 		| Some uctx -> uctx
 		| Some uctx -> uctx
 	in
 	in
 	try
 	try
@@ -199,11 +200,11 @@ let find_array_write_access ctx a tl e1 e2 p =
 		let s_type = s_type (print_context()) in
 		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
 		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 m = mk_mono() in
 	let tl,definitive_types = Abstract.find_multitype_params a pl 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 :: _ ->
 		| t1 :: _ ->
 			let stack = ref [] in
 			let stack = ref [] in
 			let rec loop t =
 			let rec loop t =
@@ -243,11 +244,11 @@ let find_multitype_specialization' com a pl p =
 	in
 	in
 	cf,follow m,tl
 	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)
 	(cf,m)
 
 
-let handle_abstract_casts ctx e =
+let handle_abstract_casts (scom : SafeCom.t) e =
 	let rec loop e = match e.eexpr with
 	let rec loop e = match e.eexpr with
 		| TNew({cl_kind = KAbstractImpl a} as c,pl,el) ->
 		| TNew({cl_kind = KAbstractImpl a} as c,pl,el) ->
 			if not (Meta.has Meta.MultiType a.a_meta) then begin
 			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
 				| _ -> raise_typing_error ("Cannot construct " ^ (s_type (print_context()) (TAbstract(a,pl)))) e.epos
 			end else begin
 			end else begin
 				(* a TNew of an abstract implementation is only generated if it is a multi type abstract *)
 				(* 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}
 				{e with etype = m}
 			end
 			end
 		| TCall({eexpr = TField(_,FStatic({cl_path=[],"Std"},{cf_name = "string"}))},[e1]) when (match follow e1.etype with TAbstract({a_impl = Some _},_) -> true | _ -> false) ->
 		| 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
 			begin match follow e1.etype with
-				| TAbstract({a_impl = Some c} as a,tl) ->
+				| TAbstract({a_impl = Some c},tl) ->
 					begin try
 					begin try
 						let cf = PMap.find "toString" c.cl_statics in
 						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()
 							call()
 						else begin
 						else begin
 							let p = e.epos in
 							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
 						end
 					with Not_found ->
 					with Not_found ->
 						e
 						e
@@ -343,14 +342,14 @@ let handle_abstract_casts ctx e =
 								else
 								else
 									el
 									el
 							in
 							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
 							maybe_cast ecall e.etype e.epos
 						with Not_found ->
 						with Not_found ->
 							(* quick_field raises Not_found if m is an abstract, we have to replicate the 'using' call here *)
 							(* quick_field raises Not_found if m is an abstract, we have to replicate the 'using' call here *)
 							match follow m with
 							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
 								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
 							| _ -> raise Not_found
 						end
 						end
 					| _ ->
 					| _ ->

+ 29 - 138
src/context/common.ml

@@ -45,127 +45,6 @@ type stats = {
 	s_macros_called : int ref;
 	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)
 class compiler_callbacks = object(self)
 	val before_typer_create = ref [];
 	val before_typer_create = ref [];
 	val after_init_macros = 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
 	method virtual get_string_pool : string -> string array option
 end
 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 = {
 type context = {
 	compilation_step : int;
 	compilation_step : int;
 	mutable stage : compiler_stage;
 	mutable stage : compiler_stage;
@@ -355,6 +241,7 @@ type context = {
 	mutable cache : CompilationCache.context_cache option;
 	mutable cache : CompilationCache.context_cache option;
 	is_macro_context : bool;
 	is_macro_context : bool;
 	mutable json_out : json_api option;
 	mutable json_out : json_api option;
+	timer_ctx : Timer.timer_context;
 	(* config *)
 	(* config *)
 	version : compiler_version;
 	version : compiler_version;
 	mutable args : string list;
 	mutable args : string list;
@@ -362,13 +249,15 @@ type context = {
 	mutable debug : bool;
 	mutable debug : bool;
 	mutable verbose : bool;
 	mutable verbose : bool;
 	mutable foptimize : bool;
 	mutable foptimize : bool;
+	mutable doinline : bool;
 	mutable platform : platform;
 	mutable platform : platform;
-	mutable config : platform_config;
+	mutable config : PlatformConfig.platform_config;
 	empty_class_path : ClassPath.class_path;
 	empty_class_path : ClassPath.class_path;
 	class_paths : ClassPaths.class_paths;
 	class_paths : ClassPaths.class_paths;
 	main : Gctx.context_main;
 	main : Gctx.context_main;
 	mutable package_rules : (string,package_rule) PMap.t;
 	mutable package_rules : (string,package_rule) PMap.t;
 	mutable report_mode : report_mode;
 	mutable report_mode : report_mode;
+	parser_state : parser_state;
 	(* communication *)
 	(* communication *)
 	mutable print : string -> unit;
 	mutable print : string -> unit;
 	mutable error : Gctx.error_function;
 	mutable error : Gctx.error_function;
@@ -452,8 +341,8 @@ let to_gctx com = {
 		| _ -> []);
 		| _ -> []);
 	include_files = com.include_files;
 	include_files = com.include_files;
 	std = com.std;
 	std = com.std;
+	timer_ctx = com.timer_ctx;
 }
 }
-
 let enter_stage com stage =
 let enter_stage com stage =
 	(* print_endline (Printf.sprintf "Entering stage %s" (s_compiler_stage stage)); *)
 	(* print_endline (Printf.sprintf "Entering stage %s" (s_compiler_stage stage)); *)
 	com.stage <- stage
 	com.stage <- stage
@@ -565,6 +454,8 @@ let stats =
 		s_macros_called = ref 0;
 		s_macros_called = ref 0;
 	}
 	}
 
 
+open PlatformConfig
+
 let default_config =
 let default_config =
 	{
 	{
 		pf_static = true;
 		pf_static = true;
@@ -792,11 +683,12 @@ let get_config com =
 
 
 let memory_marker = [|Unix.time()|]
 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 = {
 	let rec com = {
 		compilation_step = compilation_step;
 		compilation_step = compilation_step;
 		cs = cs;
 		cs = cs;
 		cache = None;
 		cache = None;
+		timer_ctx = timer_ctx;
 		stage = CCreated;
 		stage = CCreated;
 		version = version;
 		version = version;
 		args = args;
 		args = args;
@@ -814,6 +706,7 @@ let create compilation_step cs version args display_mode =
 		display = display_mode;
 		display = display_mode;
 		verbose = false;
 		verbose = false;
 		foptimize = true;
 		foptimize = true;
+		doinline = true;
 		features = Hashtbl.create 0;
 		features = Hashtbl.create 0;
 		platform = Cross;
 		platform = Cross;
 		config = default_config;
 		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;
 		empty_class_path = new ClassPath.directory_class_path "" User;
 		class_paths = new ClassPaths.class_paths;
 		class_paths = new ClassPaths.class_paths;
 		main = {
 		main = {
-			main_class = None;
+			main_path = None;
+			main_file = None;
 			main_expr = None;
 			main_expr = None;
 		};
 		};
 		package_rules = PMap.empty;
 		package_rules = PMap.empty;
@@ -845,10 +739,7 @@ let create compilation_step cs version args display_mode =
 		include_files = [];
 		include_files = [];
 		js_gen = None;
 		js_gen = None;
 		load_extern_type = [];
 		load_extern_type = [];
-		defines = {
-			defines_signature = None;
-			values = PMap.empty;
-		};
+		defines = Define.empty_defines ();
 		user_defines = Hashtbl.create 0;
 		user_defines = Hashtbl.create 0;
 		user_metas = Hashtbl.create 0;
 		user_metas = Hashtbl.create 0;
 		get_macros = (fun() -> None);
 		get_macros = (fun() -> None);
@@ -888,6 +779,12 @@ let create compilation_step cs version args display_mode =
 		hxb_reader_api = None;
 		hxb_reader_api = None;
 		hxb_reader_stats = HxbReader.create_hxb_reader_stats ();
 		hxb_reader_stats = HxbReader.create_hxb_reader_stats ();
 		hxb_writer_config = None;
 		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
 	} in
 	com
 	com
 
 
@@ -919,7 +816,8 @@ let clone com is_macro_context =
 			tstring = mk_mono();
 			tstring = mk_mono();
 		};
 		};
 		main = {
 		main = {
-			main_class = None;
+			main_path = None;
+			main_file = None;
 			main_expr = None;
 			main_expr = None;
 		};
 		};
 		features = Hashtbl.create 0;
 		features = Hashtbl.create 0;
@@ -1087,10 +985,6 @@ let platform_name_macro com =
 let find_file ctx f =
 let find_file ctx f =
 	(ctx.class_paths#find_file f).file
 	(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 =
 let mem_size v =
 	Objsize.size_with_headers (Objsize.objsize 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 =
 let display_error com ?(depth = 0) msg p =
 	display_error_ext com (Error.make_error ~depth (Custom 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 adapt_defines_to_macro_context defines =
 	let to_remove = "java" :: List.map Globals.platform_name Globals.platforms in
 	let to_remove = "java" :: List.map Globals.platform_name Globals.platforms in
 	let to_remove = List.fold_left (fun acc d -> Define.get_define_key d :: acc) to_remove [Define.NoTraces] in
 	let to_remove = List.fold_left (fun acc d -> Define.get_define_key d :: acc) to_remove [Define.NoTraces] in
@@ -1152,7 +1043,7 @@ let get_entry_point com =
 		in
 		in
 		let e = Option.get com.main.main_expr in (* must be present at this point *)
 		let e = Option.get com.main.main_expr in (* must be present at this point *)
 		(snd path, c, e)
 		(snd path, c, e)
-	) com.main.main_class
+	) com.main.main_path
 
 
 let make_unforced_lazy t_proc f where =
 let make_unforced_lazy t_proc f where =
 	let r = ref (lazy_available t_dynamic) in
 	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 cc = get_cache com in
 	let sign = Define.get_signature com.defines 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
 		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
 		else
 			let anon_identification = new Tanon_identification.tanon_identification in
 			let anon_identification = new Tanon_identification.tanon_identification in
 			let warn w s p = com.warning w com.warning_options s p 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 ->
 				| Some config ->
 					if com.is_macro_context then config.macro_config else config.target_config
 					if com.is_macro_context then config.macro_config else config.target_config
 			in
 			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
 	in
-
 	List.iter cache_module com.modules;
 	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
 	begin match com.get_macros() with
 		| None -> ()
 		| None -> ()
 		| Some com -> cache_context cs com
 		| Some com -> cache_context cs com

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

@@ -31,8 +31,8 @@ module ReferencePosition = struct
 end
 end
 
 
 let preprocess_expr com e = match com.display.dms_kind with
 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
 	| _ -> e
 
 
 let sort_fields l with_type tk =
 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 =
 	method enable_display ?(skip_define=false) mode =
 		com.display <- create mode;
 		com.display <- create mode;
-		Parser.display_mode := mode;
 		if not skip_define then Common.define_value com Define.Display "1"
 		if not skip_define then Common.define_value com Define.Display "1"
 
 
 	method set_display_file was_auto_triggered requires_offset =
 	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
 		) None in
 
 
 		let pos = if requires_offset then jsonrpc#get_int_param "offset" else (-1) 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
 		if file <> file_input_marker then begin
 			let file_unique = com.file_keys#get file in
 			let file_unique = com.file_keys#get file in
@@ -139,7 +138,7 @@ class hxb_reader_api_com
 			cc#find_module m_path
 			cc#find_module m_path
 		with Not_found ->
 		with Not_found ->
 			let mc = cc#get_hxb_module m_path in
 			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)
 			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 =
 	method basic_types =
@@ -493,7 +492,7 @@ let handler =
 	List.iter (fun (s,f) -> Hashtbl.add h s f) l;
 	List.iter (fun (s,f) -> Hashtbl.add h s f) l;
 	h
 	h
 
 
-let parse_input com input report_times =
+let parse_input com input =
 	let input =
 	let input =
 		JsonRpc.handle_jsonrpc_error (fun () -> JsonRpc.parse_request input) send_json
 		JsonRpc.handle_jsonrpc_error (fun () -> JsonRpc.parse_request input) send_json
 	in
 	in
@@ -506,9 +505,8 @@ let parse_input com input report_times =
 			"result",json;
 			"result",json;
 			"timestamp",jfloat (Unix.gettimeofday ());
 			"timestamp",jfloat (Unix.gettimeofday ());
 		] in
 		] 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
 			begin match json_of_times root with
 			| None -> fl
 			| None -> fl
 			| Some jo -> ("timers",jo) :: 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
 				| NoModule | BadModule _ -> raise Not_found
 				| BinaryModule mc ->
 				| BinaryModule mc ->
 					let api = (new TypeloadModule.hxb_reader_api_typeload ctx.com ctx.g TypeloadModule.load_module' p :> HxbReaderApi.hxb_reader_api) in
 					let api = (new TypeloadModule.hxb_reader_api_typeload ctx.com ctx.g TypeloadModule.load_module' p :> HxbReaderApi.hxb_reader_api) in
-					let reader = new HxbReader.hxb_reader path ctx.com.hxb_reader_stats (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
 					let m = reader#read_chunks api mc.mc_chunks in
 					m
 					m
 				| GoodModule 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 explore_class_paths com timer class_paths recursive f_pack f_module =
 	let cs = com.cs in
 	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 =
 let read_class_paths com timer =
 	explore_class_paths com timer (com.class_paths#filter (fun cp -> cp#path <> "")) true (fun _ -> ()) (fun file path ->
 	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)
 	not (List.exists (fun s -> String.length s > 0 && s.[0] = '_') pack)
 
 
 let collect ctx tk with_type sort =
 let collect ctx tk with_type sort =
-	let t = Timer.timer ["display";"toplevel collect"] in
 	let cctx = CollectionContext.create ctx in
 	let cctx = CollectionContext.create ctx in
 	let curpack = fst ctx.c.curclass.cl_path in
 	let curpack = fst ctx.c.curclass.cl_path in
 	(* Note: This checks for the explicit `ServerConfig.legacy_completion` setting instead of using
 	(* 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 -> ()
 	| TKType | TKOverride -> ()
 	| TKExpr p | TKPattern p | TKField p ->
 	| TKExpr p | TKPattern p | TKField p ->
 		(* locals *)
 		(* 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 add_field scope origin cf =
 			let origin,cf = match origin with
 			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
 			if not (Meta.has Meta.NoCompletion cf.cf_meta) then add_field scope origin cf
 		in
 		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 ->
 				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
 				) 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
 					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
 					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;
 	end;
 
 
 	(* type params *)
 	(* type params *)
@@ -473,75 +472,76 @@ let collect ctx tk with_type sort =
 	(* module imports *)
 	(* module imports *)
 	List.iter add_type (List.rev_map fst ctx.m.import_resolution#extract_type_imports); (* reverse! *)
 	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
 	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)
 		| s :: sl -> add_package (List.rev sl,s)
 	in
 	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
 		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 collect_and_raise ctx tk with_type cr (name,pname) pinsert =
 	let fields = match !DisplayException.last_completion_pos with
 	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 DisplayTypes.DisplayMode
 open DisplayPosition
 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 display_pos = ref (DisplayPosition.display_position#get) in
 	let was_annotated = ref false in
 	let was_annotated = ref false in
 	let is_annotated,is_completion = match dm with
 	let is_annotated,is_completion = match dm with
@@ -160,7 +160,7 @@ let find_before_pos dm e =
 			raise Exit
 			raise Exit
 		| EMeta((Meta.Markup,_,_),(EConst(String _),p)) when is_annotated p ->
 		| EMeta((Meta.Markup,_,_),(EConst(String _),p)) when is_annotated p ->
 			annotate_marked e
 			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 *)
 			(* TODO: check if this makes any sense *)
 			raise Exit
 			raise Exit
 		| EConst(Regexp _) when is_annotated (pos e) && is_completion ->
 		| EConst(Regexp _) when is_annotated (pos e) && is_completion ->
@@ -199,13 +199,13 @@ let find_before_pos dm e =
 	in
 	in
 	try map e with Exit -> e
 	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 found = ref false in
 	let handle_el e el =
 	let handle_el e el =
 		let call_arg_is_marked () =
 		let call_arg_is_marked () =
 			el = [] || List.exists (fun (e,_) -> match e with EDisplay(_,DKMarked) -> true | _ -> false) el
 			el = [] || List.exists (fun (e,_) -> match e with EDisplay(_,DKMarked) -> true | _ -> false) el
 		in
 		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;
 		found := true;
 		Parser.mk_display_expr e DKCall
 		Parser.mk_display_expr e DKCall
 		end else
 		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
 	let name,_,kind = Display.ReferencePosition.get () in
 	ignore(SyntaxExplorer.explore_uncached_modules tctx cs [name,kind])
 	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
 	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
 		| (Statistics.Referenced,p) :: relations when not (List.mem p acc) -> loop (p :: acc) relations
 		| _ :: relations -> loop acc relations
 		| _ :: relations -> loop acc relations
 		| [] -> acc
 		| [] -> acc
 	in
 	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();
 	Display.ReferencePosition.reset();
 	usages
 	usages
 
 
@@ -121,14 +119,14 @@ let rec collect_reference_positions com (name,pos,kind) =
 	| _ ->
 	| _ ->
 		[name,pos,kind]
 		[name,pos,kind]
 
 
-let find_references tctx com with_definition =
+let find_references com with_definition =
 	let pos_filters =
 	let pos_filters =
 		List.fold_left (fun acc (_,p,_) ->
 		List.fold_left (fun acc (_,p,_) ->
 			if p = null_pos then acc
 			if p = null_pos then acc
 			else Statistics.SFPos p :: acc
 			else Statistics.SFPos p :: acc
 		) [] (collect_reference_positions com (Display.ReferencePosition.get ()))
 		) [] (collect_reference_positions com (Display.ReferencePosition.get ()))
 	in
 	in
-	let usages = find_references tctx com with_definition pos_filters in
+	let usages = find_references com with_definition pos_filters in
 	let usages =
 	let usages =
 		List.sort (fun p1 p2 ->
 		List.sort (fun p1 p2 ->
 			let c = compare p1.pfile p2.pfile in
 			let c = compare p1.pfile p2.pfile in
@@ -137,29 +135,27 @@ let find_references tctx com with_definition =
 	in
 	in
 	DisplayException.raise_positions usages
 	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
 	let rec loop acc relations = match relations with
 		| ((Statistics.Implemented | Statistics.Overridden | Statistics.Extended),p) :: relations -> loop (p :: acc) relations
 		| ((Statistics.Implemented | Statistics.Overridden | Statistics.Extended),p) :: relations -> loop (p :: acc) relations
 		| _ :: relations -> loop acc relations
 		| _ :: relations -> loop acc relations
 		| [] -> acc
 		| [] -> acc
 	in
 	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();
 	Display.ReferencePosition.reset();
 	DisplayException.raise_positions usages
 	DisplayException.raise_positions usages
 
 
-let find_implementations tctx com =
+let find_implementations com =
 	let name,pos,kind = Display.ReferencePosition.get () in
 	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 []
 	else DisplayException.raise_positions []

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

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

+ 3 - 3
src/context/formatString.ml

@@ -1,7 +1,7 @@
 open Globals
 open Globals
 open Ast
 open Ast
 
 
-let format_string defines s p process_expr =
+let format_string config s p process_expr =
 	let e = ref None in
 	let e = ref None in
 	let pmin = ref p.pmin in
 	let pmin = ref p.pmin in
 	let min = ref (p.pmin + 1) 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
 					if Lexer.string_is_whitespace scode then Error.raise_typing_error "Expression cannot be empty" ep
 					else Error.raise_typing_error msg pos
 					else Error.raise_typing_error msg pos
 				in
 				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
 					| ParseError(_,(msg,p),_) -> error (Parser.error_msg msg) p
 			in
 			in
 			add_expr e slen
 			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 fold : 'acc . ('key -> 'value -> 'acc -> 'acc) -> 'acc -> 'acc
 	method virtual mem : 'key -> bool
 	method virtual mem : 'key -> bool
 	method virtual clear : unit
 	method virtual clear : unit
-
-	method virtual start_group : int
-	method virtual commit_group : int -> int
-	method virtual discard_group : int -> int
 end
 end
 
 
 class ['key,'value] pmap_lookup = object(self)
 class ['key,'value] pmap_lookup = object(self)
 	inherit ['key,'value] lookup
 	inherit ['key,'value] lookup
 	val mutable lut : ('key,'value) PMap.t = PMap.empty
 	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) =
 	method add (key : 'key) (value : 'value) =
-		groups <- PMap.map (fun modules -> key :: modules) groups;
 		lut <- PMap.add key value lut
 		lut <- PMap.add key value lut
 
 
 	method remove (key : 'key) =
 	method remove (key : 'key) =
@@ -41,36 +33,13 @@ class ['key,'value] pmap_lookup = object(self)
 
 
 	method clear =
 	method clear =
 		lut <- PMap.empty
 		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
 end
 
 
 class ['key,'value] hashtbl_lookup = object(self)
 class ['key,'value] hashtbl_lookup = object(self)
 	inherit ['key,'value] lookup
 	inherit ['key,'value] lookup
 	val lut : ('key,'value) Hashtbl.t = Hashtbl.create 0
 	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) =
 	method add (key : 'key) (value : 'value) =
-		Hashtbl.iter (fun i modules -> Hashtbl.replace groups i (key :: modules)) groups;
 		Hashtbl.replace lut key value
 		Hashtbl.replace lut key value
 
 
 	method remove (key : 'key) =
 	method remove (key : 'key) =
@@ -90,24 +59,5 @@ class ['key,'value] hashtbl_lookup = object(self)
 
 
 	method clear =
 	method clear =
 		Hashtbl.clear lut
 		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
 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 =
 	method get_list =
 		l
 		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 =
 	method cache_type_imports =
 		let rec loop = function
 		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 : typer_pass_tasks Array.t;
 	mutable delayed_min_index : int;
 	mutable delayed_min_index : int;
 	mutable debug_delayed : (typer_pass * ((unit -> unit) * (string * string list) * typer) list) list;
 	mutable debug_delayed : (typer_pass * ((unit -> unit) * (string * string list) * typer) list) list;
-	doinline : bool;
 	retain_meta : bool;
 	retain_meta : bool;
 	mutable core_api : typer option;
 	mutable core_api : typer option;
 	mutable macros : ((unit -> unit) * 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 module_check_policies : (string list * module_check_policy list * bool) list;
 	mutable global_using : (tclass * pos) list;
 	mutable global_using : (tclass * pos) list;
 	(* Indicates that Typer.create() finished building this instance *)
 	(* Indicates that Typer.create() finished building this instance *)
@@ -408,7 +406,7 @@ let unify_raise_custom uctx t1 t2 p =
 			(* no untyped check *)
 			(* no untyped check *)
 			raise_error_msg (Unify l) p
 			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 save_locals ctx =
 	let locals = ctx.f.locals in
 	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;
 	Naming.check_local_variable_name ctx.com n origin p;
 	add_local ctx (VUser origin) n t p
 	add_local ctx (VUser origin) n t p
 
 
-let gen_local_prefix = "`"
-
 let gen_local ctx t p =
 let gen_local ctx t p =
 	add_local ctx VGenerated gen_local_prefix 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));
 	delay ctx PForce (fun () -> ignore(lazy_type r));
 	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 =
 let is_forced_inline c cf =
 	match c with
 	match c with
 	| Some { cl_kind = KAbstractImpl _ } -> true
 	| Some { cl_kind = KAbstractImpl _ } -> true
@@ -517,7 +504,7 @@ let is_forced_inline c cf =
 	| _ -> false
 	| _ -> false
 
 
 let needs_inline ctx c cf =
 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 *)
 (** checks if we can access to a given class field using current context *)
 let can_access ctx c cf stat =
 let can_access ctx c cf stat =
@@ -664,6 +651,28 @@ let safe_mono_close ctx m p =
 let relative_path ctx file =
 let relative_path ctx file =
 	ctx.com.class_paths#relative_path 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 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
 	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 (
 	(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)
 				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
 	Returns type parameters and the list of types, which should be known at compile time
 	to be able to choose multitype specialization.
 	to be able to choose multitype specialization.
@@ -98,14 +96,14 @@ let rec find_multitype_params a pl =
 		tl,!definitive_types
 		tl,!definitive_types
 
 
 and find_multitype_specialization_type a pl =
 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 m = mk_mono() in
 	let tl,definitive_types = find_multitype_params a pl in
 	let tl,definitive_types = find_multitype_params a pl in
 	ignore(find_to uctx m a tl);
 	ignore(find_to uctx m a tl);
 	if List.exists (fun t -> has_mono t) definitive_types then raise Not_found;
 	if List.exists (fun t -> has_mono t) definitive_types then raise Not_found;
 	follow m
 	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 maybe_recurse t =
 		let rec loop t = match t with
 		let rec loop t = match t with
 			| TMono r ->
 			| TMono r ->
@@ -119,12 +117,12 @@ and get_underlying_type ?(return_first=false) a pl =
 			| TType (t,tl) ->
 			| TType (t,tl) ->
 				loop (apply_typedef t tl)
 				loop (apply_typedef t tl)
 			| TAbstract(a,tl) when not (Meta.has Meta.CoreType a.a_meta) ->
 			| 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 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
 					raise_typing_error ("Abstract chain detected: " ^ s) a.a_pos
 				end;
 				end;
-				get_underlying_type a tl
+				get_underlying_type' stack a tl
 			| _ ->
 			| _ ->
 				t
 				t
 		in
 		in
@@ -132,7 +130,7 @@ and get_underlying_type ?(return_first=false) a pl =
 			Even if only the first underlying type was requested
 			Even if only the first underlying type was requested
 			keep traversing to detect mutually recursive abstracts
 			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
 		if return_first then t
 		else result
 		else result
 	in
 	in
@@ -145,6 +143,9 @@ and get_underlying_type ?(return_first=false) a pl =
 		else
 		else
 			maybe_recurse (apply_params a.a_params pl a.a_this)
 			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
 and follow_with_abstracts t = match follow t with
 	| TAbstract(a,tl) when not (Meta.has Meta.CoreType a.a_meta) ->
 	| TAbstract(a,tl) when not (Meta.has Meta.CoreType a.a_meta) ->
 		follow_with_abstracts (get_underlying_type a tl)
 		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;
 	mutable defines_signature : string option;
 }
 }
 
 
+let empty_defines () = {
+	defines_signature = None;
+	values = PMap.empty;
+}
+
 type user_define = {
 type user_define = {
 	doc : string;
 	doc : string;
 	flags : define_parameter list;
 	flags : define_parameter list;
@@ -26,16 +31,18 @@ type define_infos = {
 	d_origin : define_origin;
 	d_origin : define_origin;
 	d_links : string list;
 	d_links : string list;
 	d_deprecated : string option;
 	d_deprecated : string option;
+	d_default : string option;
 }
 }
 
 
 let infos ?user_defines d =
 let infos ?user_defines d =
 	let extract_infos (t, (doc, flags), origin) =
 	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
 		List.iter (function
 			| HasParam s -> params := s :: !params
 			| HasParam s -> params := s :: !params
 			| Platforms fl -> pfs := fl @ !pfs
 			| Platforms fl -> pfs := fl @ !pfs
 			| Link url -> links := url :: !links
 			| Link url -> links := url :: !links
 			| Deprecated s -> deprecated := Some s
 			| Deprecated s -> deprecated := Some s
+			| DefaultValue s -> default := Some s
 		) flags;
 		) flags;
 		(t, {
 		(t, {
 			d_doc = doc;
 			d_doc = doc;
@@ -44,6 +51,7 @@ let infos ?user_defines d =
 			d_origin = origin;
 			d_origin = origin;
 			d_links = !links;
 			d_links = !links;
 			d_deprecated = !deprecated;
 			d_deprecated = !deprecated;
+			d_default = !default;
 		})
 		})
 	in
 	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 = {
 type t = {
 	lut : int StringHashtbl.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 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 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 =
 type platform =
 	| Cross
 	| Cross
 	| Js
 	| 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 patch_string_pos p s = { p with pmin = p.pmax - String.length s }
 
 
+let gen_local_prefix = "`"
+
 (* msg * backtrace *)
 (* msg * backtrace *)
 exception Ice of string * string
 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)
 	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__
 		Globals.die "" __LOC__
 
 
+let mkdir_mutex = Mutex.create ()
+
 let rec create_file bin ext acc = function
 let rec create_file bin ext acc = function
 	| [] -> Globals.die "" __LOC__
 	| [] -> Globals.die "" __LOC__
 	| d :: [] ->
 	| d :: [] ->
@@ -327,7 +329,7 @@ let rec create_file bin ext acc = function
 		ch
 		ch
 	| d :: l ->
 	| d :: l ->
 		let dir = String.concat "/" (List.rev (d :: acc)) in
 		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
 		create_file bin ext (d :: acc) l
 
 
 let rec mkdir_recursive base dir_list =
 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 ======= *)
 (* ======= General utility ======= *)
 
 
 let alloc_var' =
 let alloc_var' =
-	let uid = ref 0 in
+	let uid = Atomic.make 0 in
 	uid,(fun kind n t p ->
 	uid,(fun kind n t p ->
-		incr uid;
+		Atomic.incr uid;
 		{
 		{
 			v_kind = kind;
 			v_kind = kind;
 			v_name = n;
 			v_name = n;
 			v_type = t;
 			v_type = t;
-			v_id = !uid;
+			v_id = Atomic.get uid;
 			v_extra = None;
 			v_extra = None;
 			v_meta = [];
 			v_meta = [];
 			v_pos = p;
 			v_pos = p;
@@ -307,15 +307,19 @@ let null_abstract = {
 let create_dependency mdep origin =
 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}
 	{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
 let add_dependency ?(skip_postprocess=false) m mdep = function
 	(* These module dependency origins should not add as a dependency *)
 	(* These module dependency origins should not add as a dependency *)
 	| MDepFromMacroInclude -> ()
 	| MDepFromMacroInclude -> ()
 
 
 	| origin ->
 	| 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
 		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
 		end
 
 
 let arg_name (a,_) = a.v_name
 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
 module MonomorphPrinting = struct
-	let show_mono_ids = true
+	let show_mono_ids = ref true
 
 
 	let s_mono_constraint_kind s_type constr =
 	let s_mono_constraint_kind s_type constr =
 		let rec loop = function
 		let rec loop = function
@@ -42,7 +42,7 @@ module MonomorphPrinting = struct
 		loop constr
 		loop constr
 
 
 	let print_mono_name m id extra =
 	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
 			Printf.sprintf "Unknown<%d>" id
 		else
 		else
 			"Unknown"
 			"Unknown"

+ 56 - 45
src/core/tUnification.ml

@@ -40,6 +40,10 @@ type type_param_mode =
 	| TpDefault
 	| TpDefault
 	| TpDefinition of type_param_unification_context
 	| TpDefinition of type_param_unification_context
 
 
+type 'a rec_stack = {
+	mutable rec_stack : 'a list;
+}
+
 type unification_context = {
 type unification_context = {
 	allow_transitive_cast   : bool;
 	allow_transitive_cast   : bool;
 	allow_abstract_cast     : bool; (* allows a non-transitive abstract cast (from,to,@:from,@:to) *)
 	allow_abstract_cast     : bool; (* allows a non-transitive abstract cast (from,to,@:from,@:to) *)
@@ -49,6 +53,11 @@ type unification_context = {
 	equality_underlying     : bool;
 	equality_underlying     : bool;
 	strict_field_kind       : bool;
 	strict_field_kind       : bool;
 	type_param_mode         : type_param_mode;
 	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 =
 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_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 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_transitive_cast   = true;
 	allow_abstract_cast     = true;
 	allow_abstract_cast     = true;
 	allow_dynamic_to_cast   = true;
 	allow_dynamic_to_cast   = true;
@@ -75,6 +86,11 @@ let default_unification_context = {
 	equality_underlying     = false;
 	equality_underlying     = false;
 	strict_field_kind       = false;
 	strict_field_kind       = false;
 	type_param_mode         = TpDefault;
 	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. *)
 (* Unify like targets (e.g. Java) probably would. *)
@@ -87,6 +103,11 @@ let native_unification_context = {
 	allow_arg_name_mismatch = true;
 	allow_arg_name_mismatch = true;
 	strict_field_kind       = false;
 	strict_field_kind       = false;
 	type_param_mode         = TpDefault;
 	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
 module Monomorph = struct
@@ -193,14 +214,14 @@ module Monomorph = struct
 			()
 			()
 		| CTypes tl ->
 		| CTypes tl ->
 			List.iter (fun (t2,name) ->
 			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
 				match name with
 				| Some name -> check_constraint name f
 				| Some name -> check_constraint name f
 				| None -> f()
 				| None -> f()
 			) tl
 			) tl
 		| CStructural(fields,is_open) ->
 		| CStructural(fields,is_open) ->
 			let t2 = mk_anon ~fields (ref Closed) in
 			let t2 = mk_anon ~fields (ref Closed) in
-			(!unify_ref) default_unification_context t t2
+			(!unify_ref) (default_unification_context()) t t2
 		| CMixed l ->
 		| CMixed l ->
 			List.iter (fun constr -> check_down_constraints constr t) l
 			List.iter (fun constr -> check_down_constraints constr t) l
 
 
@@ -224,7 +245,7 @@ module Monomorph = struct
 	let check_up_constraints m t =
 	let check_up_constraints m t =
 		List.iter (fun (t2,constraint_name) ->
 		List.iter (fun (t2,constraint_name) ->
 			let check() =
 			let check() =
-				(!unify_ref) default_unification_context t2 t
+				(!unify_ref) (default_unification_context()) t2 t
 			in
 			in
 			match constraint_name with
 			match constraint_name with
 			| Some name -> check_constraint name check
 			| Some name -> check_constraint name check
@@ -519,11 +540,6 @@ let unify_kind ~(strict:bool) k1 k2 =
 				| _ -> false)
 				| _ -> false)
 		| _ -> 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_exists f s = List.exists f s.rec_stack
 let rec_stack_memq v s = List.memq v s.rec_stack
 let rec_stack_memq v s = List.memq v s.rec_stack
 let rec_stack_loop stack value f arg =
 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;
 		stack.rec_stack <- List.tl stack.rec_stack;
 		raise e
 		raise e
 
 
-let eq_stack = new_rec_stack()
-
 let rec_stack stack value fcheck frun ferror =
 let rec_stack stack value fcheck frun ferror =
 	if not (rec_stack_exists fcheck stack) then begin
 	if not (rec_stack_exists fcheck stack) then begin
 		try
 		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 ->
 	| 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
 		type_eq_params uctx a b tl1 tl2
 	| TType (t,tl) , _ when can_follow a ->
 	| 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() -> 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))
 			(fun l -> error (cannot_unify a b :: l))
 	| _ , TType (t,tl) when can_follow b ->
 	| _ , 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() -> try_apply_params_rec t.t_params tl t.t_type (type_eq uctx a))
 			(fun l -> error (cannot_unify a b :: l))
 			(fun l -> error (cannot_unify a b :: l))
 	| TEnum (e1,tl1) , TEnum (e2,tl2) ->
 	| TEnum (e1,tl1) , TEnum (e2,tl2) ->
@@ -711,27 +725,22 @@ let type_iseq uctx a b =
 
 
 let type_iseq_strict a b =
 let type_iseq_strict a b =
 	try
 	try
-		type_eq {default_unification_context with equality_kind = EqStricter} a b;
+		type_eq {(default_unification_context()) with equality_kind = EqStricter} a b;
 		true
 		true
 	with Unify_error _ ->
 	with Unify_error _ ->
 		false
 		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 ctx = print_context() in
 	let st = s_type ctx in
 	let st = s_type ctx in
 	print_endline "unify_stack";
 	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";
 	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";
 	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";
 	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 =
 let rec unify (uctx : unification_context) a b =
 	if a == b then
 	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]
 		| None -> if uctx.equality_kind = EqStricter || not (link uctx t b a) then error [cannot_unify a b]
 		| Some t -> unify uctx a t)
 		| Some t -> unify uctx a t)
 	| TType (t,tl) , _ ->
 	| 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(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() -> 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))
 			(fun l -> error (cannot_unify a b :: l))
 	| _ , TType (t,tl) ->
 	| _ , 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(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() -> try_apply_params_rec t.t_params tl t.t_type (unify uctx a))
 			(fun l -> error (cannot_unify a b :: l))
 			(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
 				(match f2.cf_kind with
 				| Var { v_read = AccNo } | Var { v_read = AccNever } ->
 				| Var { v_read = AccNo } | Var { v_read = AccNever } ->
 					(* we will do a recursive unification, so let's check for possible recursion *)
 					(* 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));
 						(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 } ->
 				| Method MethNormal | Method MethInline | Var { v_write = AccNo } | Var { v_write = AccNever } ->
 					(* same as before, but unification is reversed (read-only var) *)
 					(* 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));
 						(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 *)
 					(* will use fast_eq, which have its own stack *)
 					try
 					try
@@ -1074,7 +1083,7 @@ and get_nested_context uctx =
 	{uctx with allow_abstract_cast = true}
 	{uctx with allow_abstract_cast = true}
 
 
 and unifies_with_abstract uctx a b f =
 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
 		(uctx.allow_transitive_cast && f {uctx with allow_transitive_cast = false}) || f uctx
 	) false
 	) false
 
 
@@ -1153,7 +1162,7 @@ and unify_with_variance uctx f t1 t2 =
 	let t1 = follow_without_type t1 in
 	let t1 = follow_without_type t1 in
 	let t2 = follow_without_type t2 in
 	let t2 = follow_without_type t2 in
 	let fail () = error [cannot_unify t1 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_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 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
 	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 =
 	let unifies_abstract uctx a b ab tl ats =
 		try
 		try
 			let uctx = get_abstract_context uctx a b ab in
 			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 ->
 				List.exists (does_func_unify_arg (fun at ->
 					let at = apply_params ab.a_params tl at in
 					let at = apply_params ab.a_params tl at in
 					if ats == ab.a_to then
 					if ats == ab.a_to then
@@ -1242,19 +1251,21 @@ and unify_with_access uctx f1 t1 f2 =
 
 
 let does_unify a b =
 let does_unify a b =
 	try
 	try
-		unify default_unification_context a b;
+		unify (default_unification_context()) a b;
 		true
 		true
 	with Unify_error _ ->
 	with Unify_error _ ->
 		false
 		false
 
 
 let unify_custom = unify
 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_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_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
 module UnifyMinT = struct
 	let collect_base_types t =
 	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;
 	id : string list;
-	mutable start : float list;
-	mutable pauses : float list;
 	mutable total : float;
 	mutable total : float;
+	mutable pauses : float;
 	mutable calls : int;
 	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 ->
 	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
 let timer_threshold = 0.01
 
 
@@ -104,7 +98,8 @@ type timer_node = {
 	mutable children : timer_node list;
 	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 nodes = Hashtbl.create 0 in
 	let rec root = {
 	let rec root = {
 		name = "";
 		name = "";
@@ -156,7 +151,7 @@ let build_times_tree () =
 		let node = loop root timer.id in
 		let node = loop root timer.id in
 		if not (List.memq node root.children) then
 		if not (List.memq node root.children) then
 			root.children <- node :: root.children
 			root.children <- node :: root.children
-	) htimers;
+	) ctx.timer_lut;
 	let max_name = ref 0 in
 	let max_name = ref 0 in
 	let max_calls = ref 0 in
 	let max_calls = ref 0 in
 	let rec loop depth node =
 	let rec loop depth node =
@@ -175,8 +170,8 @@ let build_times_tree () =
 	loop 0 root;
 	loop 0 root;
 	!max_name,!max_calls,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
 	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 "#");
 	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
 	let sep = String.make (max_name + max_calls + 27) '-' in
@@ -192,24 +187,4 @@ let report_times print =
 	in
 	in
 	List.iter (loop 0) root.children;
 	List.iter (loop 0) root.children;
 	print sep;
 	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;
 	wo_mode : warning_mode;
 }
 }
 
 
-let parse_options s ps lexbuf =
+let parse_options lctx s ps lexbuf =
 	let fail msg p =
 	let fail msg p =
 		raise_typing_error msg {p with pmin = ps.pmin + p.pmin; pmax = ps.pmin + p.pmax}
 		raise_typing_error msg {p with pmin = ps.pmin + p.pmin; pmax = ps.pmin + p.pmax}
 	in
 	in
@@ -22,7 +22,7 @@ let parse_options s ps lexbuf =
 			fail (Printf.sprintf "Unknown warning: %s" s) p
 			fail (Printf.sprintf "Unknown warning: %s" s) p
 		end
 		end
 	in
 	in
-	let parse_warning () = match Lexer.token lexbuf with
+	let parse_warning () = match Lexer.token lctx lexbuf with
 		| Const (Ident s),p ->
 		| Const (Ident s),p ->
 			parse_string s p
 			parse_string s p
 		| (_,p) ->
 		| (_,p) ->
@@ -31,7 +31,7 @@ let parse_options s ps lexbuf =
 	let add acc mode warning =
 	let add acc mode warning =
 		{ wo_warning = warning; wo_mode = mode } :: acc
 		{ wo_warning = warning; wo_mode = mode } :: acc
 	in
 	in
-	let rec next acc = match Lexer.token lexbuf with
+	let rec next acc = match Lexer.token lctx lexbuf with
 		| Binop OpAdd,_ ->
 		| Binop OpAdd,_ ->
 			next (add acc WMEnable (parse_warning()))
 			next (add acc WMEnable (parse_warning()))
 		| Binop OpSub,_ ->
 		| Binop OpSub,_ ->
@@ -44,13 +44,9 @@ let parse_options s ps lexbuf =
 	next []
 	next []
 
 
 let parse_options s ps =
 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 from_meta ml =
 	let parse_arg e = match fst e with
 	let parse_arg e = match fst e with

+ 1 - 0
src/dune

@@ -22,6 +22,7 @@
 		unix ipaddr str bigarray threads dynlink
 		unix ipaddr str bigarray threads dynlink
 		xml-light extlib sha terminal_size
 		xml-light extlib sha terminal_size
 		luv
 		luv
+		domainslib
 	)
 	)
 	(modules (:standard \ haxe prebuild))
 	(modules (:standard \ haxe prebuild))
 	(preprocess (per_module
 	(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 Globals
-open Ast
 open Type
 open Type
-open Common
-open Typecore
+open PlatformConfig
 open Error
 open Error
 open ExceptionFunctions
 open ExceptionFunctions
 
 
 type context = {
 type context = {
-	typer : typer;
+	scom : SafeCom.t;
 	basic : basic_types;
 	basic : basic_types;
 	config : exceptions_config;
 	config : exceptions_config;
 	wildcard_catch_type : Type.t;
 	wildcard_catch_type : Type.t;
@@ -19,13 +17,9 @@ type context = {
 	haxe_native_stack_trace : tclass;
 	haxe_native_stack_trace : tclass;
 	value_exception_type : Type.t;
 	value_exception_type : Type.t;
 	value_exception_class : tclass;
 	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)`
 	Generate `haxe.Exception.method_name(args)`
 *)
 *)
@@ -39,8 +33,8 @@ let haxe_exception_static_call ctx method_name args p =
 		| TFun(_,t) -> t
 		| TFun(_,t) -> t
 		| _ -> raise_typing_error ("haxe.Exception." ^ method_name ^ " is not a function and cannot be called") p
 		| _ -> raise_typing_error ("haxe.Exception." ^ method_name ^ " is not a function and cannot be called") p
 	in
 	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)`
 	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
 				raise_typing_error ((s_type (print_context()) haxe_exception.etype) ^ "." ^ method_name ^ " is not a function and cannot be called") p
 		in
 		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
 	| _ -> 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 std_is ctx e t p =
 	let t = follow t in
 	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`
 	Check if type path of `t` exists in `lst`
@@ -492,62 +477,6 @@ let catch_native ctx catches t p =
 	in
 	in
 	transform [] None catches
 	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.
 	Transform `throw` and `try..catch` expressions.
 	`rename_locals` is required to deal with the names of temp vars.
 	`rename_locals` is required to deal with the names of temp vars.
@@ -574,140 +503,4 @@ let filter ectx =
 			else stub e
 			else stub e
 		)
 		)
 	| None ->
 	| 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.
 	Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  *)
  *)
 
 
-open Ast
-open Common
 open Type
 open Type
-open Typecore
+open SafeCom
 open Error
 open Error
 open Globals
 open Globals
 open FiltersCommon
 open FiltersCommon
 
 
 let get_native_name = Native.get_native_name
 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 *)
 (* PASS 2 begin *)
 
 
 (* Applies exclude macro (which turns types into externs) *)
 (* 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 ->
 	| TClassDecl c when has_class_flag c CExcluded ->
 		add_class_flag c CExtern
 		add_class_flag c CExtern
 	| TEnumDecl e when has_enum_flag e EnExcluded ->
 	| 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 *)
 (* 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 ->
 	| 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 ->
 			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;
 				if b then c.cl_fields <- PMap.remove f.cf_name c.cl_fields;
 				not b
 				not b
 			) c.cl_ordered_fields;
 			) c.cl_ordered_fields;
 			c.cl_ordered_statics <- List.filter (fun f ->
 			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;
 				if b then c.cl_statics <- PMap.remove f.cf_name c.cl_statics;
 				not b
 				not b
 			) c.cl_ordered_statics;
 			) 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
 let check_private_path com t = match t with
 	| TClassDecl c when c.cl_private ->
 	| TClassDecl c when c.cl_private ->
 		let rpath = (fst c.cl_module.m_path,"_" ^ snd c.cl_module.m_path) in
 		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 *)
 (* Adds the __rtti field if required *)
-let add_rtti com t =
+let add_rtti scom t =
 	let rec has_rtti c =
 	let rec has_rtti c =
 		Meta.has Meta.Rtti c.cl_meta || match c.cl_super with None -> false | Some (csup,_) -> has_rtti csup
 		Meta.has Meta.Rtti c.cl_meta || match c.cl_super with None -> false | Some (csup,_) -> has_rtti csup
 	in
 	in
 	match t with
 	match t with
 	| TClassDecl c when has_rtti c && not (PMap.mem "__rtti" c.cl_statics) ->
 	| 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);
 		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_ordered_statics <- f :: c.cl_ordered_statics;
 		c.cl_statics <- PMap.add f.cf_name f c.cl_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 *)
 (* 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 ->
 	| TClassDecl c ->
 		(match Texpr.build_metadata com.basic t with
 		(match Texpr.build_metadata com.basic t with
 		| None -> ()
 		| None -> ()
 		| Some e ->
 		| 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
 			let cf = mk_field ~static:true "__meta__" e.etype e.epos null_pos in
 			cf.cf_expr <- Some e;
 			cf.cf_expr <- Some e;
 			let can_deal_with_interface_metadata () = match com.platform with
 			let can_deal_with_interface_metadata () = match com.platform with
@@ -411,10 +150,10 @@ let commit_features com t =
 		Common.add_feature com k;
 		Common.add_feature com k;
 	) m.m_extra.m_features
 	) m.m_extra.m_features
 
 
-let check_reserved_type_paths com t =
+let check_reserved_type_paths scom t =
 	let check path pos =
 	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
 		end
 	in
 	in
 	match t with
 	match t with
@@ -439,68 +178,88 @@ let iter_expressions fl mt =
 
 
 open FilterContext
 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 *)
 		(* 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
 		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
 			| "std" -> DceStd
 			| "no" -> DceNo
 			| "no" -> DceNo
 			| _ -> failwith ("Unknown DCE mode " ^ dce_mode)
 			| _ -> failwith ("Unknown DCE mode " ^ dce_mode)
 		in
 		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;
 	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 visited_anons = ref [] in
 	let rec check_t m t = match t with
 	let rec check_t m t = match t with
 		| TInst(c,tl) ->
 		| TInst(c,tl) ->
@@ -529,7 +288,7 @@ let update_cache_dependencies ~close_monomorphs com t =
 					check_t m t
 					check_t m t
 				| _ ->
 				| _ ->
 					(* Bind any still open monomorph that's part of a signature to Any now (issue #10653) *)
 					(* 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
 		end
 		| TLazy f ->
 		| TLazy f ->
 			check_t m (lazy_type 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 *)
 (* 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
 	(* Update m_processed here. This means that nothing should add a dependency afterwards because
 	   then the module is immediately considered uncached again *)
 	   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
 	match t with
 	| TClassDecl c ->
 	| TClassDecl c ->
 		let vars = ref [] in
 		let vars = ref [] in
@@ -646,9 +405,47 @@ let might_need_cf_unoptimized c cf =
 	| _ ->
 	| _ ->
 		has_class_field_flag cf CfGeneric
 		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 new_types = List.filter (fun t ->
 		let cached = is_cached com t in
 		let cached = is_cached com t in
 		begin match t with
 		begin match t with
@@ -675,6 +472,8 @@ let run tctx ectx main before_destruction =
 		end;
 		end;
 		not cached
 		not cached
 	) com.types in
 	) com.types in
+	let new_types_array = Array.of_list new_types in
+
 	(* IMPORTANT:
 	(* IMPORTANT:
 	    There may be types in new_types which have already been post-processed, but then had their m_processed flag unset
 	    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.
 		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.
 		be aware of this.
 	*)
 	*)
 	NullSafety.run com new_types;
 	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;
 		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 ->
 		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;
 		) 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;
 		com.callbacks#run com.error_ext com.callbacks#get_after_save;
 	);
 	);
 	before_destruction();
 	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 Common
 open Typecore
 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
 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;
 		add_class_flag c CExtern;
 	| _ ->
 	| _ ->
 		()
 		()
@@ -53,51 +37,10 @@ let is_overridden cls field =
 	in
 	in
 	List.exists (fun d -> loop_inheritance d) cls.cl_descendants
 	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 is_cached com t =
 	let m = (t_infos t).mt_module.m_extra in
 	let m = (t_infos t).mt_module.m_extra in
 	m.m_processed <> 0 && m.m_processed < com.compilation_step
 	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
 	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 Globals
 open Type
 open Type
-open Common
 open Ast
 open Ast
+open PlatformConfig
 
 
 type rename_init = {
 type rename_init = {
 	mutable ri_scope : var_scope;
 	mutable ri_scope : var_scope;
@@ -25,7 +25,7 @@ let reserve_init ri name =
 	Make all module-level names reserved.
 	Make all module-level names reserved.
 	No local variable will have a name matching a module-level declaration.
 	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 ->
 	List.iter (fun mt ->
 		let tinfos = t_infos mt in
 		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
 		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
 			) fl
 		| _ ->
 		| _ ->
 			reserve_init ri native_name
 			reserve_init ri native_name
-	) com.types
+	) types
 
 
 (**
 (**
 	Initialize the context for local variables renaming
 	Initialize the context for local variables renaming
 *)
 *)
-let init com =
+let init config types =
 	let ri = {
 	let ri = {
-		ri_scope = com.config.pf_scoping.vs_scope;
+		ri_scope = config.pf_scoping.vs_scope;
 		ri_reserved = StringMap.empty;
 		ri_reserved = StringMap.empty;
 		ri_hoisting = false;
 		ri_hoisting = false;
 		ri_no_shadowing = false;
 		ri_no_shadowing = false;
@@ -72,35 +72,35 @@ let init com =
 		| ReserveNames names ->
 		| ReserveNames names ->
 			List.iter (reserve_init ri) names
 			List.iter (reserve_init ri) names
 		| ReserveAllTopLevelSymbols ->
 		| 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 ->
 		| 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
 		| ReserveCurrentTopLevelSymbol -> ri.ri_reserve_current_top_level_symbol <- true
-	) com.config.pf_scoping.vs_flags;
+	) config.pf_scoping.vs_flags;
 	ri
 	ri
 
 
 module Overlaps = struct
 module Overlaps = struct
 	type t = {
 	type t = {
 		mutable ov_vars : tvar list;
 		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;
 		mutable ov_name_cache : bool StringMap.t option;
 	}
 	}
 
 
 	let create () = {
 	let create () = {
 		ov_vars = [];
 		ov_vars = [];
-		ov_lut = Hashtbl.create 0;
+		ov_lut = IntHashtbl.create 0;
 		ov_name_cache = None;
 		ov_name_cache = None;
 	}
 	}
 
 
 	let copy ov = {
 	let copy ov = {
 		ov_vars = ov.ov_vars;
 		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;
 		ov_name_cache = ov.ov_name_cache;
 	}
 	}
 
 
 	let add v ov =
 	let add v ov =
 		ov.ov_vars <- v :: ov.ov_vars;
 		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
 		ov.ov_name_cache <- None
 
 
 	let get_cache ov = match ov.ov_name_cache with
 	let get_cache ov = match ov.ov_name_cache with
@@ -118,11 +118,11 @@ module Overlaps = struct
 		List.iter f ov.ov_vars
 		List.iter f ov.ov_vars
 
 
 	let mem id ov =
 	let mem id ov =
-		Hashtbl.mem ov.ov_lut id
+		IntHashtbl.mem ov.ov_lut id
 
 
 	let reset ov =
 	let reset ov =
 		ov.ov_vars <- [];
 		ov.ov_vars <- [];
-		Hashtbl.clear ov.ov_lut;
+		IntHashtbl.clear ov.ov_lut;
 		ov.ov_name_cache <- None
 		ov.ov_name_cache <- None
 
 
 	let is_empty ov = match ov.ov_vars with
 	let is_empty ov = match ov.ov_vars with
@@ -167,7 +167,7 @@ type rename_context = {
 	rc_scope : var_scope;
 	rc_scope : var_scope;
 	mutable rc_reserved : bool StringMap.t;
 	mutable rc_reserved : bool StringMap.t;
 	(** Scope a variable is declared in *)
 	(** 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
 			end
 	in
 	in
 	scope.own_vars <- (v, overlaps) :: scope.own_vars;
 	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
 	if scope.loop_count > 0 then
 		Overlaps.add v scope.loop_vars
 		Overlaps.add v scope.loop_vars
 
 
@@ -255,7 +255,7 @@ let use_var rc scope v =
 	if not (will_be_reserved rc v) then
 	if not (will_be_reserved rc v) then
 		determine_overlaps rc scope v
 		determine_overlaps rc scope v
 	else begin
 	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 =
 		let rec loop scope =
 			if scope != origin then begin
 			if scope != origin then begin
 				if (rc.rc_no_shadowing || rc.rc_hoisting) then
 				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
 		v.v_name <- name
 	in
 	in
 	(* chop escape char for all local variables generated *)
 	(* 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
 		let name = String.sub v.v_name 1 (String.length v.v_name - 1) in
 		commit ("_g" ^ (Str.replace_first trailing_numbers "" name))
 		commit ("_g" ^ (Str.replace_first trailing_numbers "" name))
 	end;
 	end;
@@ -391,7 +391,7 @@ let run cl_path ri e =
 		rc_no_catch_var_shadowing = ri.ri_no_catch_var_shadowing;
 		rc_no_catch_var_shadowing = ri.ri_no_catch_var_shadowing;
 		rc_switch_cases_no_blocks = ri.ri_switch_cases_no_blocks;
 		rc_switch_cases_no_blocks = ri.ri_switch_cases_no_blocks;
 		rc_reserved = ri.ri_reserved;
 		rc_reserved = ri.ri_reserved;
-		rc_var_origins = Hashtbl.create 0;
+		rc_var_origins = IntHashtbl.create 0;
 	} in
 	} in
 	if ri.ri_reserve_current_top_level_symbol then begin
 	if ri.ri_reserve_current_top_level_symbol then begin
 		match cl_path with
 		match cl_path with

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

@@ -1,9 +1,8 @@
 open Globals
 open Globals
-open Common
+open SafeCom
 open Type
 open Type
 
 
-
-let add_field_inits cl_path locals com t =
+let add_field_inits cl_path locals scom t =
 	let apply c =
 	let apply c =
 		let ethis = mk (TConst TThis) (TInst (c,extract_param_types c.cl_params)) c.cl_pos in
 		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 *)
 		(* 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 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
 			let cf = match c.cl_constructor with
 			| None ->
 			| None ->
-				let ct = TFun([],com.basic.tvoid) in
+				let ct = TFun([],scom.basic.tvoid) in
 				let ce = mk (TFunction {
 				let ce = mk (TFunction {
 					tf_args = [];
 					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
 				}) ct c.cl_pos in
 				let ctor = mk_field "new" ct c.cl_pos null_pos in
 				let ctor = mk_field "new" ct c.cl_pos null_pos in
 				ctor.cf_kind <- Method MethNormal;
 				ctor.cf_kind <- Method MethNormal;
@@ -42,20 +41,21 @@ let add_field_inits cl_path locals com t =
 				match cf.cf_expr with
 				match cf.cf_expr with
 				| Some { eexpr = TFunction f } ->
 				| Some { eexpr = TFunction f } ->
 					let bl = match f.tf_expr with {eexpr = TBlock b } -> b | x -> [x] in
 					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 };
 					{cf with cf_expr = Some ce };
 				| _ ->
 				| _ ->
 					die "" __LOC__
 					die "" __LOC__
 			in
 			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;
 			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;
 			add_class_field_flag cf CfPostProcessed;
 			(match cf.cf_expr with
 			(match cf.cf_expr with
 			| Some e ->
 			| Some e ->
 				(* This seems a bit expensive, but hopefully constructor expressions aren't that massive. *)
 				(* This seems a bit expensive, but hopefully constructor expressions aren't that massive. *)
 				let e = RenameVars.run cl_path locals e in
 				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
 				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.
 	Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  *)
  *)
 open Globals
 open Globals
+open SafeCom
 open Type
 open Type
-open Common
 open LocalUsage
 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 *)
 	(* optimized version for Java - use native arrays *)
 	| Jvm ->
 	| Jvm ->
 		let cnativearray =
 		let cnativearray =
@@ -84,7 +65,26 @@ let captured_vars com e =
 			method mk_init av v pos =
 			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
 				mk (TVar (av,Some (mk (TArrayDecl [mk (TLocal v) v.v_type pos]) av.v_type pos))) t.tvoid pos
 		end
 		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 mk_var v used =
 		let v2 = alloc_var v.v_kind v.v_name (PMap.find v.v_id used) v.v_pos in
 		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
 				Create a new function scope to make sure that the captured loop variable
 				will not be overwritten in next loop iteration
 				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). *)
 				(* 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 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
 				let rec loop e = match e.eexpr with
@@ -273,7 +273,7 @@ let captured_vars com e =
 		!assigned
 		!assigned
 	in
 	in
 	let captured = all_vars e in
 	let captured = all_vars e in
-	match com.config.pf_capture_policy with
+	match scom.platform_config.pf_capture_policy with
 	| CPNone -> e
 	| CPNone -> e
 	| CPWrapRef -> do_wrap captured e
 	| CPWrapRef -> do_wrap captured e
 	| CPLoopVars -> out_loop 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 Type
-open Typecore
 open Error
 open Error
 
 
 type lscontext = {
 type lscontext = {
-	ctx : typer;
-	lut : (int,tclass_field) Hashtbl.t;
+	scom : SafeCom.t;
+	lut : tclass_field IntHashtbl.t;
 	mutable added_fields : tclass_field list;
 	mutable added_fields : tclass_field list;
 }
 }
 
 
 let promote_local_static lsctx run v eo =
 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
 	begin try
 		let cf = PMap.find name c.cl_statics in
 		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:[
 		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;
 		lsctx.added_fields <- cf :: lsctx.added_fields;
 		(* Add to lookup early so that the duplication check works. *)
 		(* Add to lookup early so that the duplication check works. *)
 		c.cl_statics <- PMap.add cf.cf_name cf c.cl_statics;
 		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
 	end
 
 
 let find_local_static lut v =
 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 = {
 	let lsctx = {
-		ctx = ctx;
-		lut = Hashtbl.create 0;
+		scom = scom;
+		lut = IntHashtbl.create 0;
 		added_fields = [];
 		added_fields = [];
 	} in
 	} in
-	let c = ctx.c.curclass in
+	let c = scom.curclass in
 	let rec run e = match e.eexpr with
 	let rec run e = match e.eexpr with
 		| TBlock el ->
 		| TBlock el ->
 			let el = ExtList.List.filter_map (fun e -> match e.eexpr with
 			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 Type
-open Typecore
+open SafeCom
 open Globals
 open Globals
 
 
 let rec collect_new_args_values ctx args declarations values n =
 let rec collect_new_args_values ctx args declarations values n =
 	match args with
 	match args with
 	| [] -> declarations, values
 	| [] -> declarations, values
 	| arg :: rest ->
 	| 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
 		and value = { arg with eexpr = TLocal v } in
 		collect_new_args_values ctx rest (decl :: declarations) (value :: values) (n + 1)
 		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 replacement_for_TReturn ctx fn args p =
 	let temps_rev, args_rev = collect_new_args_values ctx args [] [] 0
 	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;
 		epos = p;
 		eexpr = TMeta ((Meta.TailRecursion, [], null_pos), {
 		eexpr = TMeta ((Meta.TailRecursion, [], null_pos), {
 			eexpr = TBlock ((List.rev temps_rev) @ (assign_args fn.tf_args (List.rev args_rev)) @ [continue]);
 			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;
 			epos = p;
 		});
 		});
 	}
 	}
@@ -55,7 +55,7 @@ let rec redeclare_vars ctx vars declarations replace_list =
 		let decl =
 		let decl =
 			{
 			{
 				eexpr = TVar (new_v, Some { eexpr = TLocal v; etype = v.v_type; epos = v.v_pos; });
 				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;
 				epos = v.v_pos;
 			}
 			}
 		in
 		in
@@ -78,7 +78,7 @@ let rec replace_vars replace_list in_tail_recursion e =
 
 
 let wrap_loop ctx args body =
 let wrap_loop ctx args body =
 	let wrap e =
 	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) }
 		{ e with eexpr = TWhile (cond, e, Ast.NormalWhile) }
 	in
 	in
 	match collect_captured_args args body with
 	match collect_captured_args args body with
@@ -154,7 +154,7 @@ let rec transform_function ctx is_recursive_call fn =
 		if !add_loop then
 		if !add_loop then
 			let body =
 			let body =
 				if ExtType.is_void (follow fn.tf_type) then
 				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
 				else
 					body
 					body
 			in
 			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
 		check_expr (has_tail_recursion is_recursive_call cancel_tre function_end) e
 
 
 let run ctx =
 let run ctx =
-	if Common.defined ctx.com Define.NoTre then
+	if Define.defined ctx.defines Define.NoTre then
 		(fun e -> e)
 		(fun e -> e)
 	else
 	else
 		(fun e ->
 		(fun e ->
 			match e.eexpr with
 			match e.eexpr with
 			| TFunction fn ->
 			| TFunction fn ->
 				let is_tre_eligible =
 				let is_tre_eligible =
-					match ctx.f.curfield.cf_kind with
+					match ctx.curfield.cf_kind with
 					| Method MethDynamic -> false
 					| Method MethDynamic -> false
 					| Method MethInline -> true
 					| Method MethInline -> true
 					| Method MethNormal ->
 					| 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
 					in
 				let is_recursive_call callee args =
 				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
 				in
 				if has_tail_recursion is_recursive_call false true fn.tf_expr then
 				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); *)
 					(* 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_type : t;
   tcv_default : texpr option;
   tcv_default : texpr option;
 
 
+  tcv_has_getter : bool;
   tcv_is_stackonly : bool;
   tcv_is_stackonly : bool;
   tcv_is_gc_element : bool;
   tcv_is_gc_element : bool;
   tcv_is_reflective : 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_type = field.cf_type;
     tcv_default = None;
     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_stackonly = has_meta Meta.StackOnly field.cf_meta;
     tcv_is_reflective = reflective class_def field;
     tcv_is_reflective = reflective class_def field;
     tcv_is_gc_element = cpp_type_of field.cf_type |> is_gc_element ctx;
     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
       value
     in
     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
     if var.tcv_is_reflective && not (is_abstract_impl class_def) then
       let variable = get_wrapper var.tcv_field var.tcv_name in
       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 prop_check = checkPropCall var.tcv_field in
         let getter     = Printf.sprintf "get_%s()" var.tcv_field.cf_name |> get_wrapper 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
         (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
         (var.tcv_field.cf_name, String.length var.tcv_field.cf_name, var_printer variable) :: acc
     else
     else
       acc
       acc
@@ -608,11 +607,11 @@ let generate_managed_class base_ctx tcpp_class =
       acc
       acc
   in
   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 prop_check = checkPropCall var.tcv_field in
       let getter     = Printf.sprintf "get_%s()" var.tcv_field.cf_name |> get_wrapper 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
     else
       acc
       acc
   in
   in

+ 4 - 2
src/generators/gctx.ml

@@ -3,7 +3,8 @@ open Type
 open Warning
 open Warning
 
 
 type context_main = {
 type context_main = {
-	mutable main_class : path option;
+	mutable main_path : path option;
+	mutable main_file : string option;
 	mutable main_expr : texpr option;
 	mutable main_expr : texpr option;
 }
 }
 
 
@@ -31,6 +32,7 @@ type t = {
 	native_libs : NativeLibraries.native_library_base list;
 	native_libs : NativeLibraries.native_library_base list;
 	include_files : (string * string) list;
 	include_files : (string * string) list;
 	std : tclass; (* TODO: I would prefer to not have this here, have to check default_cast *)
 	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 =
 let defined com s =
@@ -108,7 +110,7 @@ let get_entry_point gctx =
 		in
 		in
 		let e = Option.get gctx.main.main_expr in (* must be present at this point *)
 		let e = Option.get gctx.main.main_expr in (* must be present at this point *)
 		(snd path, c, e)
 		(snd path, c, e)
-	) gctx.main.main_class
+	) gctx.main.main_path
 
 
 let get_es_version defines =
 let get_es_version defines =
 	try int_of_string (Define.defined_value defines Define.JsEs) with _ -> 0
 	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_decls        = (Enum enum) :: acc.decls in
          let acc_boot_enums   = enum_def.e_path :: acc.boot_enums 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
          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 with decls = acc_decls; boot_enums = acc_boot_enums; exe_classes = acc_exe_classes; ids = ids }
       | _ ->
       | _ ->
          acc
          acc
@@ -429,30 +429,30 @@ let generate_source ctx =
      end;
      end;
    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)
    | Some path -> (snd path)
    | _ -> "output" in
    | _ -> "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_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;
    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
    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
    end
 
 
 let generate common_ctx =
 let generate common_ctx =
@@ -462,7 +462,7 @@ let generate common_ctx =
    if (Gctx.defined common_ctx Define.Cppia) then begin
    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
       let ctx = new_context common_ctx debug_level (ref PMap.empty) StringMap.empty super_deps constructor_deps in
       CppCppia.generate_cppia ctx
       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
       let ctx = new_context common_ctx debug_level (ref PMap.empty) (create_member_types common_ctx) super_deps constructor_deps in
       generate_source ctx
       generate_source ctx
    end
    end

+ 95 - 43
src/generators/genhl.ml

@@ -86,6 +86,7 @@ type constval =
 
 
 type context = {
 type context = {
 	com : Gctx.t;
 	com : Gctx.t;
+	num_domains : int;
 	cglobals : (string, ttype) lookup;
 	cglobals : (string, ttype) lookup;
 	cstrings : (string, string) lookup;
 	cstrings : (string, string) lookup;
 	cbytes : (bytes, bytes) lookup;
 	cbytes : (bytes, bytes) lookup;
@@ -95,11 +96,11 @@ type context = {
 	cfids : (string * path, unit) lookup;
 	cfids : (string * path, unit) lookup;
 	cfunctions : fundecl DynArray.t;
 	cfunctions : fundecl DynArray.t;
 	cconstants : (constval, (global * int array)) lookup;
 	cconstants : (constval, (global * int array)) lookup;
+	hl_ver : string;
 	optimize : bool;
 	optimize : bool;
 	w_null_compare : bool;
 	w_null_compare : bool;
 	overrides : (string * path, bool) Hashtbl.t;
 	overrides : (string * path, bool) Hashtbl.t;
 	defined_funs : (int,unit) Hashtbl.t;
 	defined_funs : (int,unit) Hashtbl.t;
-	mutable dump_out : (unit IO.output) option;
 	mutable cached_types : (string list, ttype) PMap.t;
 	mutable cached_types : (string list, ttype) PMap.t;
 	mutable m : method_context;
 	mutable m : method_context;
 	mutable anons_cache : (tanon, ttype) PMap.t;
 	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))
 				(fun tref -> to_type ~tref ctx (Abstract.get_underlying_type a pl))
 
 
 and resolve_class ctx c pl statics =
 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
 	match c.cl_path, pl with
 	| ([],"Array"), [t] ->
 	| ([],"Array"), [t] ->
 		if statics then ctx.array_impl.abase else array_class ctx (to_type ctx t)
 		if statics then ctx.array_impl.abase else array_class ctx (to_type ctx t)
 	| ([],"Array"), [] ->
 	| ([],"Array"), [] ->
 		die "" __LOC__
 		die "" __LOC__
-	| _, _ when (has_class_flag c CExtern) ->
-		not_supported()
 	| _ ->
 	| _ ->
 		c
 		c
 
 
@@ -640,7 +636,7 @@ and class_type ?(tref=None) ctx c pl statics =
 			) :: ctx.ct_delayed;
 			) :: ctx.ct_delayed;
 			fid
 			fid
 		in
 		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
 			if is_extern_field f || (statics && f.cf_name = "__meta__") then () else
 			let fid = (match f.cf_kind with
 			let fid = (match f.cf_kind with
 			| Method m when m <> MethDynamic && not statics ->
 			| Method m when m <> MethDynamic && not statics ->
@@ -763,7 +759,50 @@ and enum_class ctx e =
 		} in
 		} in
 		let t = HObj p in
 		let t = HObj p in
 		ctx.cached_types <- PMap.add key_path t ctx.cached_types;
 		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
 		t
 
 
 and alloc_fun_path ctx path name =
 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
 	let t = class_type ctx c [] static in
 	alloc_global ctx ("$" ^ s_type_path c.cl_path) t, t
 	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__)
 	lookup ctx.cglobals ("$" ^ cpath) (fun() -> die "" __LOC__)
 
 
-let resolve_type ctx path =
+and resolve_type ctx path =
 	PMap.find path ctx.cached_types
 	PMap.find path ctx.cached_types
 
 
-let alloc_std ctx name args ret =
+and alloc_std ctx name args ret =
 	let lib = "std" in
 	let lib = "std" in
 	(* different from :hlNative to prevent mismatch *)
 	(* different from :hlNative to prevent mismatch *)
 	let nid = lookup ctx.cnatives ("$" ^ name ^ "@" ^ lib, -1) (fun() ->
 	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
 	let _,_,_,fid = DynArray.get ctx.cnatives.arr nid in
 	fid
 	fid
 
 
-let alloc_fresh ctx t =
+and alloc_fresh ctx t =
 	let rid = DynArray.length ctx.m.mregs.arr in
 	let rid = DynArray.length ctx.m.mregs.arr in
 	DynArray.add ctx.m.mregs.arr t;
 	DynArray.add ctx.m.mregs.arr t;
 	rid
 	rid
 
 
-let alloc_tmp ctx t =
+and alloc_tmp ctx t =
 	if not ctx.optimize then alloc_fresh ctx t else
 	if not ctx.optimize then alloc_fresh ctx t else
 	let a = try PMap.find t ctx.m.mallocs with Not_found ->
 	let a = try PMap.find t ctx.m.mallocs with Not_found ->
 		let a = {
 		let a = {
@@ -830,13 +869,13 @@ let alloc_tmp ctx t =
 	| r :: _ ->
 	| r :: _ ->
 		r
 		r
 
 
-let current_pos ctx =
+and current_pos ctx =
 	DynArray.length ctx.m.mops
 	DynArray.length ctx.m.mops
 
 
-let rtype ctx r =
+and rtype ctx r =
 	DynArray.get ctx.m.mregs.arr r
 	DynArray.get ctx.m.mregs.arr r
 
 
-let hold ctx r =
+and hold ctx r =
 	if not ctx.optimize then () else
 	if not ctx.optimize then () else
 	let t = rtype ctx r in
 	let t = rtype ctx r in
 	let a = PMap.find t ctx.m.mallocs 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_all <- loop a.a_all;
 	a.a_hold <- r :: a.a_hold
 	a.a_hold <- r :: a.a_hold
 
 
-let free ctx r =
+and free ctx r =
 	if not ctx.optimize then () else
 	if not ctx.optimize then () else
 	let t = rtype ctx r in
 	let t = rtype ctx r in
 	let a = PMap.find t ctx.m.mallocs in
 	let a = PMap.find t ctx.m.mallocs in
@@ -872,10 +911,10 @@ let free ctx r =
 	in
 	in
 	if !last then a.a_all <- loop a.a_all
 	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
 	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;
 	if new_var then decl_var ctx v;
 	try
 	try
 		Hashtbl.find ctx.m.mvars v.v_id
 		Hashtbl.find ctx.m.mvars v.v_id
@@ -886,11 +925,11 @@ let alloc_var ctx v new_var =
 		r
 		r
 
 
 
 
-let push_op ctx o =
+and push_op ctx o =
 	DynArray.add ctx.m.mdebug ctx.m.mcurpos;
 	DynArray.add ctx.m.mdebug ctx.m.mcurpos;
 	DynArray.add ctx.m.mops o
 	DynArray.add ctx.m.mops o
 
 
-let op ctx o =
+and op ctx o =
 	match o with
 	match o with
 	| OMov (a,b) when a = b ->
 	| 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
 		let r = alloc_tmp ctx t in
 		op ctx (OFloat (r,alloc_float ctx (Int32.to_float i)));
 		op ctx (OFloat (r,alloc_float ctx (Int32.to_float i)));
 		r
 		r
-	| TConst (TInt i), HF32 ->
+	| TConst (TInt i), HF32 when ctx.hl_ver >= "1.15" ->
 		let r = alloc_tmp ctx t in
 		let r = alloc_tmp ctx t in
 		op ctx (OFloat (r, alloc_float ctx (Int32.to_float i)));
 		op ctx (OFloat (r, alloc_float ctx (Int32.to_float i)));
 		r
 		r
-	| TConst (TFloat f), HF32 ->
+	| TConst (TFloat f), HF32 when ctx.hl_ver >= "1.15" ->
 		let r = alloc_tmp ctx t in
 		let r = alloc_tmp ctx t in
 		op ctx (OFloat (r, alloc_float ctx (float_of_string f)));
 		op ctx (OFloat (r, alloc_float ctx (float_of_string f)));
 		r
 		r
@@ -2367,7 +2406,7 @@ and eval_expr ctx e =
 		| _ -> unsafe_cast_to ctx r to_t e.epos)
 		| _ -> unsafe_cast_to ctx r to_t e.epos)
 	| TObjectDecl fl ->
 	| TObjectDecl fl ->
 		(match to_type ctx e.etype with
 		(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
 			let r = alloc_tmp ctx t in
 			op ctx (ONew r);
 			op ctx (ONew r);
 			hold ctx r;
 			hold ctx r;
@@ -3261,6 +3300,7 @@ and gen_method_wrapper ctx rt t p =
 			code = DynArray.to_array ctx.m.mops;
 			code = DynArray.to_array ctx.m.mops;
 			debug = make_debug ctx ctx.m.mdebug;
 			debug = make_debug ctx ctx.m.mdebug;
 			assigns = Array.of_list (List.rev ctx.m.massign);
 			assigns = Array.of_list (List.rev ctx.m.massign);
+			need_opt = false;
 		} in
 		} in
 		ctx.m <- old;
 		ctx.m <- old;
 		DynArray.add ctx.cfunctions f;
 		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;
 		code = DynArray.to_array ctx.m.mops;
 		debug = make_debug ctx ctx.m.mdebug;
 		debug = make_debug ctx ctx.m.mdebug;
 		assigns = Array.of_list (List.sort (fun (_,p1) (_,p2) -> p1 - p2) (List.rev ctx.m.massign));
 		assigns = Array.of_list (List.sort (fun (_,p1) (_,p2) -> p1 - p2) (List.rev ctx.m.massign));
+		need_opt = (gen_content = None || name <> ("",""));
 	} in
 	} in
 	ctx.m <- old;
 	ctx.m <- old;
 	Hashtbl.add ctx.defined_funs fidx ();
 	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
 	capt
 
 
 let generate_static ctx c f =
 let generate_static ctx c f =
@@ -3461,8 +3494,7 @@ let generate_static ctx c f =
 			| (Meta.HlNative,[(EConst(String(lib,_)),_)] ,_ ) :: _ ->
 			| (Meta.HlNative,[(EConst(String(lib,_)),_)] ,_ ) :: _ ->
 				add_native lib f.cf_name
 				add_native lib f.cf_name
 			| (Meta.HlNative,[(EConst(Float(ver,_)),_)] ,_ ) :: _ ->
 			| (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() =
 					let gen_content() =
 						op ctx (OThrow (make_string ctx ("Requires compiling with -D hl-ver=" ^ ver ^ ".0 or higher") null_pos));
 						op ctx (OThrow (make_string ctx ("Requires compiling with -D hl-ver=" ^ ver ^ ".0 or higher") null_pos));
 					in
 					in
@@ -3693,8 +3725,10 @@ let generate_static_init ctx types main =
 				let rt = alloc_tmp ctx HType in
 				let rt = alloc_tmp ctx HType in
 				op ctx (OType (rt, t));
 				op ctx (OType (rt, t));
 				let r = alloc_tmp ctx (class_type ctx ctx.base_enum [] false) in
 				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));
 				op ctx (OCall2 (r, alloc_fun_path ctx ([],"Type") "initEnum", ret, rt));
 				free ctx ret;
 				free ctx ret;
+				op ctx (OSafeCast (etr, r));
 
 
 				let index name =
 				let index name =
 					match et with
 					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 (OGetArray (rd,avalues, reg_int ctx f.ef_index));
 						op ctx (OSafeCast (r, rd));
 						op ctx (OSafeCast (r, rd));
 						op ctx (OSetGlobal (g,r));
 						op ctx (OSetGlobal (g,r));
+						op ctx (OSetField (etr, index f.ef_name ,r));
 				) e.e_names;
 				) e.e_names;
 
 
 				(match Texpr.build_metadata ctx.com.basic (TEnumDecl e) with
 				(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 =
 	let get_type name =
 		try
 		try
 			List.find (fun t -> (t_infos t).mt_path = (["hl"],name)) com.types
 			List.find (fun t -> (t_infos t).mt_path = (["hl"],name)) com.types
@@ -4126,9 +4161,10 @@ let create_context com dump =
 	in
 	in
 	let ctx = {
 	let ctx = {
 		com = com;
 		com = com;
+		hl_ver = Gctx.defined_value_safe ~default:"" com Define.HlVer;
 		optimize = not (Gctx.raw_defined com "hl_no_opt");
 		optimize = not (Gctx.raw_defined com "hl_no_opt");
 		w_null_compare = Gctx.raw_defined com "hl_w_null_compare";
 		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;
 		m = method_context 0 HVoid null_capture false;
 		cints = new_lookup();
 		cints = new_lookup();
 		cstrings = new_lookup();
 		cstrings = new_lookup();
@@ -4258,12 +4294,28 @@ let generate com =
 		close_out ch;
 		close_out ch;
 	end else
 	end else
 
 
-	let ctx = create_context com dump in
+	let ctx = create_context com in
 	add_types ctx com.types;
 	add_types ctx com.types;
+
 	let code = build_code ctx com.types com.main.main_expr in
 	let code = build_code ctx com.types com.main.main_expr in
 	Array.sort (fun (lib1,_,_,_) (lib2,_,_,_) -> lib1 - lib2) code.natives;
 	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
 	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
 		let ch = open_out_bin "dump/hlcode.txt" in
 		Hlcode.dump (fun s -> output_string ch (s ^ "\n")) code;
 		Hlcode.dump (fun s -> output_string ch (s ^ "\n")) code;
 		close_out ch;
 		close_out ch;
@@ -4283,7 +4335,7 @@ let generate com =
 		check ctx;
 		check ctx;
 		Hlinterp.check com.error code;
 		Hlinterp.check com.error code;
 	end;
 	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 escape_command s =
 		let b = Buffer.create 0 in
 		let b = Buffer.create 0 in
@@ -4300,8 +4352,8 @@ let generate com =
 			let version_revision = com.version.revision in
 			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);
 			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;
 		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";
 		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();
 		t();
 	end else begin
 	end else begin
@@ -4321,7 +4373,7 @@ let generate com =
 	end;
 	end;
 	if Gctx.defined com Define.Interp then
 	if Gctx.defined com Define.Interp then
 		try
 		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
 			let ctx = Hlinterp.create true in
 			Hlinterp.add_code ctx code;
 			Hlinterp.add_code ctx code;
 			t();
 			t();

+ 162 - 87
src/generators/genjvm.ml

@@ -51,6 +51,11 @@ let get_construction_mode c cf =
 	else ConstructInit
 	else ConstructInit
 
 
 (* Haxe *)
 (* Haxe *)
+type mutexes = {
+	write_class : Mutex.t;
+	unify : Mutex.t;
+	closure_lookup : Mutex.t;
+}
 
 
 type generation_context = {
 type generation_context = {
 	gctx : Gctx.t;
 	gctx : Gctx.t;
@@ -59,19 +64,18 @@ type generation_context = {
 	entry_point : (tclass * texpr) option;
 	entry_point : (tclass * texpr) option;
 	t_exception : Type.t;
 	t_exception : Type.t;
 	t_throwable : 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;
 	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;
 	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;
 	jar_compression_level : int;
 	dynamic_level : int;
 	dynamic_level : int;
+	mutexes : mutexes;
 }
 }
 
 
 type ret =
 type ret =
@@ -100,10 +104,8 @@ let run_timed gctx detail name f =
 	if detail && not gctx.detail_times then
 	if detail && not gctx.detail_times then
 		f()
 		f()
 	else begin
 	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
 	end
 
 
 class file_output
 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({cl_path = ["_Enum"],"Enum_Impl_"},_) -> java_class_sig
 	| TInst(c,tl) -> TObject(c.cl_path,List.map jtype_argument_of_type tl)
 	| TInst(c,tl) -> TObject(c.cl_path,List.map jtype_argument_of_type tl)
 	| TEnum(en,tl) ->
 	| TEnum(en,tl) ->
-		Hashtbl.replace gctx.enum_paths en.e_path ();
 		TObject(en.e_path,List.map jtype_argument_of_type tl)
 		TObject(en.e_path,List.map jtype_argument_of_type tl)
 	| TFun(tl,tr) -> method_sig (List.map (fun (_,o,t) ->
 	| TFun(tl,tr) -> method_sig (List.map (fun (_,o,t) ->
 		let jsig = jsignature_of_type t in
 		let jsig = jsignature_of_type t in
@@ -352,11 +353,12 @@ let write_class gctx path jc =
 		| (sl,s) -> String.concat "/" sl ^ "/" ^ s
 		| (sl,s) -> String.concat "/" sl ^ "/" ^ s
 	in
 	in
 	let path = dir ^ ".class" 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 =
 let is_const_int_pattern case =
 	List.for_all (fun e -> match e.eexpr with
 	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 map t = apply_params c.cl_params c_monos t in
 			let cf_monos = Monomorph.spawn_constrained_monos map cf.cf_params in
 			let cf_monos = Monomorph.spawn_constrained_monos map cf.cf_params in
 			try
 			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 _ ->
 			with Unify_error _ ->
 				()
 				()
 		) gctx.functional_interfaces
 		) gctx.functional_interfaces
 	end
 	end
 
 
 let create_typed_function gctx kind jc jm context =
 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 create_field_closure gctx jc path_this jm name jsig t =
 	let jsig_this = object_path_sig path_this in
 	let jsig_this = object_path_sig path_this in
 	let context = ["this",jsig_this] in
 	let context = ["this",jsig_this] in
 	let wf = create_typed_function gctx (FuncMember(path_this,name)) jc jm context 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
 	begin match t with
-		| None ->
-			()
-		| Some t ->
-			associate_functional_interfaces gctx wf t
+	| None ->
+		()
+	| Some t ->
+		associate_functional_interfaces gctx wf t
 	end;
 	end;
-	let jc_closure = wf#get_class in
 	ignore(wf#generate_constructor true);
 	ignore(wf#generate_constructor true);
 	let args,ret = match jsig with
 	let args,ret = match jsig with
 		| TMethod(args,ret) ->
 		| 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 create_field_closure gctx jc path_this jm name jsig f t =
 	let jsig_this = object_path_sig path_this in
 	let jsig_this = object_path_sig path_this in
+	Mutex.lock gctx.mutexes.closure_lookup;
 	let closure_path = try
 	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 ->
 	with Not_found ->
 		let closure_path = create_field_closure gctx jc path_this jm name jsig t in
 		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
 		closure_path
 	in
 	in
 	jm#construct ConstructInit closure_path (fun () ->
 	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_sig jsig = RValue (Some jsig,None)
 let rvalue_type gctx t name = RValue (Some (jsignature_of_type gctx t),name)
 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
 class texpr_to_jvm
 	(gctx : generation_context)
 	(gctx : generation_context)
 	(field_info : field_generation_info option)
 	(field_info : field_generation_info option)
@@ -537,12 +552,14 @@ class texpr_to_jvm
 	method add_named_local (name : string) (jsig : jsignature) =
 	method add_named_local (name : string) (jsig : jsignature) =
 		jm#add_local name jsig VarArgument
 		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
 		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) =
 	method get_local_by_id (vid,vname) =
 		if vid = 0 && env = None then
 		if vid = 0 && env = None then
 			(0,(fun () -> jm#load_this),(fun () -> die "" __LOC__))
 			(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#construct ConstructInit jc_closure#get_this_path (fun () -> []);
 		jm_init#putstatic jc_closure#get_this_path jf_closure#get_name jf_closure#get_jsig;
 		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 =
 	method tfunction ret e tf =
 		let outside,accesses_this = Texpr.collect_captured_vars e in
 		let outside,accesses_this = Texpr.collect_captured_vars e in
 		let env = List.map (fun v ->
 		let env = List.map (fun v ->
@@ -612,34 +672,17 @@ class texpr_to_jvm
 			| _ -> []
 			| _ -> []
 		in
 		in
 		let args,ret =
 		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)
 			args,(return_of_type gctx tf.tf_type)
 		in
 		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
 		let handler = new texpr_to_jvm gctx field_info jc_closure jm_invoke ret in
 		handler#set_env env;
 		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;
 		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;
 		handler#texpr RReturn tf.tf_expr;
 		begin match env with
 		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) =
 	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
 		let jsig = method_sig (List.map snd args) ret in
+		Mutex.lock gctx.mutexes.closure_lookup;
 		let closure_path = try
 		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 ->
 		with Not_found ->
 			let wf = create_typed_function gctx (FuncStatic(path,name)) jc jm [] in
 			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
 			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);
 			ignore(wf#generate_constructor false);
 			let jm_invoke = wf#generate_invoke args ret [] in
 			let jm_invoke = wf#generate_invoke args ret [] in
 			let vars = List.map (fun (name,jsig) ->
 			let vars = List.map (fun (name,jsig) ->
@@ -707,7 +755,7 @@ class texpr_to_jvm
 			) vars;
 			) vars;
 			jm_invoke#invokestatic path name (method_sig (List.map snd args) ret);
 			jm_invoke#invokestatic path name (method_sig (List.map snd args) ret);
 			jm_invoke#return;
 			jm_invoke#return;
-			Hashtbl.add gctx.closure_paths (path,name,jsig) jc_closure#get_this_path;
+
 			(* Static init *)
 			(* Static init *)
 			self#make_static_closure_field name jc_closure;
 			self#make_static_closure_field name jc_closure;
 			write_class gctx jc_closure#get_this_path (jc_closure#export_class gctx.default_export_config);
 			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));
 			jm#invokestatic haxe_jvm_path "compare" (method_sig [object_sig;object_sig] (Some TInt));
 			let op = flip_cmp_op op in
 			let op = flip_cmp_op op in
 			CmpNormal(op,TBool)
 			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
 			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;
 			code#swap;
 			fun_compare path1 sig2
 			fun_compare path1 sig2
 		| [(TObject _ | TArray _ | TMethod _) as t1;(TObject _ | TArray _ | TMethod _) as t2] ->
 		| [(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
 		if not jm#is_terminated then self#texpr' ret e
 
 
 	method 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
 		match e.eexpr with
 		| TVar(v,Some e1) ->
 		| TVar(v,Some e1) ->
 			self#texpr (rvalue_type gctx v.v_type (Some v.v_name)) 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
 				e,[],None
 		in
 		in
 		let handler = new texpr_to_jvm gctx field_info jc jm tr 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
 			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;
 			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;
 		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
 		begin match mtype with
 		| MConstructor ->
 		| MConstructor ->
 			DynArray.iter (fun e ->
 			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
 		| 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 path = pfm.pfm_path in
 		let fields = convert_fields gctx pfm in
 		let fields = convert_fields gctx pfm in
 		let jc = new JvmClass.builder path haxe_dynamic_object_path in
 		let jc = new JvmClass.builder path haxe_dynamic_object_path in
@@ -2959,7 +3011,9 @@ let generate_anons gctx =
 			) c.cl_ordered_fields
 			) c.cl_ordered_fields
 		end;
 		end;
 		write_class gctx path (jc#export_class gctx.default_export_config)
 		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 generate_typed_functions gctx =
 	let jc_function = gctx.typed_functions#generate in
 	let jc_function = gctx.typed_functions#generate in
@@ -3026,8 +3080,11 @@ module Preprocessor = struct
 				match mt with
 				match mt with
 				| TClassDecl c when has_runtime_meta c.cl_meta && has_class_flag c CInterface ->
 				| TClassDecl c when has_runtime_meta c.cl_meta && has_class_flag c CInterface ->
 					() (* TODO: run-time interface metadata is a problem (issue #2042) *)
 					() (* 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);
 					check_path (t_infos mt);
+					Hashtbl.replace gctx.enum_paths en.e_path ();
 				| TTypeDecl td ->
 				| TTypeDecl td ->
 					check_path (t_infos mt);
 					check_path (t_infos mt);
 					gctx.anon_identification#identify_typedef td
 					gctx.anon_identification#identify_typedef td
@@ -3036,13 +3093,24 @@ module Preprocessor = struct
 			) m.m_types
 			) m.m_types
 		) gctx.gctx.modules;
 		) gctx.gctx.modules;
 		(* preprocess classes *)
 		(* 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 ->
 		List.iter (fun mt ->
 			match mt with
 			match mt with
 			| TClassDecl c ->
 			| TClassDecl c ->
 				if not (has_class_flag c CInterface) then
 				if not (has_class_flag c CInterface) then
 					gctx.preprocessor#preprocess_class c
 					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
 					check_functional_interface gctx c
+				end
 			| _ -> ()
 			| _ -> ()
 		) gctx.gctx.types;
 		) gctx.gctx.types;
 		(* find typedef-interface implementations *)
 		(* find typedef-interface implementations *)
@@ -3109,19 +3177,21 @@ let generate jvm_flag gctx =
 		preprocessor = Obj.magic ();
 		preprocessor = Obj.magic ();
 		typedef_interfaces = Obj.magic ();
 		typedef_interfaces = Obj.magic ();
 		typed_functions = new JvmFunctions.typed_functions;
 		typed_functions = new JvmFunctions.typed_functions;
-		known_typed_functions = Hashtbl.create 0;
 		closure_paths = Hashtbl.create 0;
 		closure_paths = Hashtbl.create 0;
 		enum_paths = Hashtbl.create 0;
 		enum_paths = Hashtbl.create 0;
 		default_export_config = {
 		default_export_config = {
 			export_debug = true;
 			export_debug = true;
 		};
 		};
 		detail_times = Gctx.raw_defined gctx "jvm_times";
 		detail_times = Gctx.raw_defined gctx "jvm_times";
-		timer = new Timer.timer ["generate";"java"];
 		jar_compression_level = compression_level;
 		jar_compression_level = compression_level;
 		dynamic_level = dynamic_level;
 		dynamic_level = dynamic_level;
 		functional_interfaces = [];
 		functional_interfaces = [];
+		mutexes = {
+			write_class = Mutex.create();
+			unify = Mutex.create();
+			closure_lookup = Mutex.create();
+		}
 	} in
 	} in
-	Hashtbl.add gctx.known_typed_functions haxe_function_path ();
 	gctx.preprocessor <- new preprocessor gctx.gctx.basic (jsignature_of_type gctx);
 	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 <- new typedef_interfaces gctx.preprocessor#get_infos anon_identification;
 	gctx.typedef_interfaces#add_interface_rewrite (["haxe";"root"],"Iterator") (["java";"util"],"Iterator") true;
 	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
 		let filename = StringHelper.escape_res_name name ['/';'-'] in
 		gctx.out#add_entry v filename;
 		gctx.out#add_entry v filename;
 	) gctx.gctx.resources;
 	) 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
 	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 =
 	let manifest_content =
 		"Manifest-Version: 1.0\n" ^
 		"Manifest-Version: 1.0\n" ^

+ 18 - 0
src/generators/genshared.ml

@@ -52,6 +52,22 @@ module Info = struct
 	end
 	end
 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 Info
 open OverloadResolution
 open OverloadResolution
 open Tanon_identification
 open Tanon_identification
@@ -170,6 +186,7 @@ object(self)
 		let has_dynamic_instance_method = ref false in
 		let has_dynamic_instance_method = ref false in
 		let has_field_init = ref false in
 		let has_field_init = ref false in
 		let field mtype cf =
 		let field mtype cf =
+			patch_optional basic cf;
 			match mtype with
 			match mtype with
 			| MConstructor ->
 			| MConstructor ->
 				()
 				()
@@ -199,6 +216,7 @@ object(self)
 				()
 				()
 			end;
 			end;
 		| Some cf ->
 		| Some cf ->
+			patch_optional basic cf;
 			let field cf =
 			let field cf =
 				if !has_dynamic_instance_method then make_haxe cf;
 				if !has_dynamic_instance_method then make_haxe cf;
 				begin match cf.cf_expr with
 				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
 		{header with h_frame_count = header.h_frame_count + 1},loop tags
 	| _ -> swf in
 	| _ -> swf in
 	(* write swf/swc *)
 	(* 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;
 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;
 		try_scope_reg = None;
 		for_call = false;
 		for_call = false;
 	} in
 	} 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
 			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
 			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;
 	mutable fe_calling : function_entry list;
 }
 }
 
 
-type context = {
+type global_context = {
 	version : int;
 	version : int;
-	out : Buffer.t;
-	mutable tabs : string;
+	hash_mutex : Mutex.t;
 	hash_cache : (int, int32) Hashtbl.t;
 	hash_cache : (int, int32) Hashtbl.t;
 	hash_mem : (int32, bool) Hashtbl.t;
 	hash_mem : (int32, bool) Hashtbl.t;
 	mutable hash_cache_list : int list;
 	mutable hash_cache_list : int list;
 	hlcode : code;
 	hlcode : code;
 	dir : string;
 	dir : string;
-	mutable curfile : string;
 	mutable cfiles : string list;
 	mutable cfiles : string list;
 	ftable : function_entry array;
 	ftable : function_entry array;
 	htypes : (ttype, string) PMap.t;
 	htypes : (ttype, string) PMap.t;
 	gnames : string array;
 	gnames : string array;
 	bytes_names : 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;
 	mutable defines : string list;
 	defined_funs : (int, unit) Hashtbl.t;
 	defined_funs : (int, unit) Hashtbl.t;
 	hdefines : (string, unit) Hashtbl.t;
 	hdefines : (string, unit) Hashtbl.t;
 	mutable defined_types : (ttype, unit) PMap.t;
 	mutable defined_types : (ttype, unit) PMap.t;
-	mutable file_prefix : string;
 	mutable fun_index : int;
 	mutable fun_index : int;
-	mutable type_module : (ttype, code_module) PMap.t;
-	gcon : Gctx.t;
+	file_prefix : string;
 }
 }
 
 
 let sprintf = Printf.sprintf
 let sprintf = Printf.sprintf
@@ -216,8 +221,10 @@ let unblock ctx =
 	ctx.tabs <- String.sub ctx.tabs 0 (String.length ctx.tabs - 1)
 	ctx.tabs <- String.sub ctx.tabs 0 (String.length ctx.tabs - 1)
 
 
 let hash ctx sid =
 let hash ctx sid =
+	Mutex.protect ctx.hash_mutex (fun () ->
 	try
 	try
-		Hashtbl.find ctx.hash_cache sid
+		let h = Hashtbl.find ctx.hash_cache sid in
+		h
 	with Not_found ->
 	with Not_found ->
 		let rec loop h =
 		let rec loop h =
 			if Hashtbl.mem ctx.hash_mem h then loop (Int32.add h Int32.one) else 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;
 		Hashtbl.add ctx.hash_mem h true;
 		ctx.hash_cache_list <- sid :: ctx.hash_cache_list;
 		ctx.hash_cache_list <- sid :: ctx.hash_cache_list;
 		h
 		h
+	)
 
 
 let type_name ctx t =
 let type_name ctx t =
 	try PMap.find t ctx.htypes with Not_found -> Globals.die (tstr t) __LOC__
 	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 ();
 		Hashtbl.add ctx.hdefines s ();
 	end
 	end
 
 
-let rec define_type ctx t =
+let rec define_type gctx ctx t =
 	match t with
 	match t with
 	| HVoid | HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64 | HBool | HBytes | HDyn | HArray _ | HType | HDynObj | HNull _ | HRef _ | HGUID -> ()
 	| HVoid | HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64 | HBool | HBytes | HDyn | HArray _ | HType | HDynObj | HNull _ | HRef _ | HGUID -> ()
 	| HAbstract _ ->
 	| HAbstract _ ->
 		define ctx "#include <hl/natives.h>";
 		define ctx "#include <hl/natives.h>";
 	| HFun (args,ret) | HMethod (args,ret) ->
 	| 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) ->
 	| HEnum _ | HObj _ | HStruct _ when not (PMap.exists t ctx.defined_types) ->
 		ctx.defined_types <- PMap.add 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) ->
 	| HVirtual vp when not (PMap.exists t ctx.defined_types) ->
 		ctx.defined_types <- PMap.add 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 ->
 	| HPacked t ->
-		define_type ctx t
+		define_type gctx ctx t
 	| HEnum _ | HObj _ | HStruct _ | HVirtual _ ->
 	| 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);
 	define ctx (sprintf "extern hl_type %s;" n);
 	"&" ^ 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
 	let cname,_, tl = e.efields.(i) in
 	if Array.length tl = 0 then
 	if Array.length tl = 0 then
 		"venum"
 		"venum"
 	else
 	else
 	let name = if e.eid = 0 then
 	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
 		"Enum" ^ name
 	else
 	else
 		String.concat "_" (ExtString.String.nsplit e.ename ".")
 		String.concat "_" (ExtString.String.nsplit e.ename ".")
@@ -284,12 +292,12 @@ let output ctx str =
 let output_char ctx c =
 let output_char ctx c =
 	Buffer.add_char ctx.out c
 	Buffer.add_char ctx.out c
 
 
-let line ctx str =
+let linec ctx str =
 	output ctx ctx.tabs;
 	output ctx ctx.tabs;
 	output ctx str;
 	output ctx str;
 	output_char ctx '\n'
 	output_char ctx '\n'
 
 
-let expr ctx str =
+let exprc ctx str =
 	output ctx ctx.tabs;
 	output ctx ctx.tabs;
 	output ctx str;
 	output ctx str;
 	output ctx ";\n"
 	output ctx ";\n"
@@ -301,6 +309,11 @@ let obj_field fid name =
 
 
 let bom = "\xEF\xBB\xBF"
 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 close_file ctx =
 	let out = Buffer.contents ctx.out in
 	let out = Buffer.contents ctx.out in
 	let defines = List.rev ctx.defines in
 	let defines = List.rev ctx.defines in
@@ -312,23 +325,20 @@ let close_file ctx =
 	Hashtbl.clear ctx.defined_funs;
 	Hashtbl.clear ctx.defined_funs;
 	Buffer.reset ctx.out;
 	Buffer.reset ctx.out;
 	let fpath = ctx.dir ^ "/" ^ ctx.curfile in
 	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
 	let fcontent = (try Std.input_file ~bin:true fpath with _ -> "") in
 	if fcontent <> str then begin
 	if fcontent <> str then begin
-		Path.mkdir_recursive "" (ExtString.String.nsplit (Filename.dirname fpath) "/");
 		let ch = open_out_bin fpath in
 		let ch = open_out_bin fpath in
 		output_string ch str;
 		output_string ch str;
 		close_out ch;
 		close_out ch;
 	end
 	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
 	let fid = if ft.fe_decl = None then -1 else fid in
 	if not (Hashtbl.mem ctx.defined_funs fid) then begin
 	if not (Hashtbl.mem ctx.defined_funs fid) then begin
 		Hashtbl.add ctx.defined_funs fid ();
 		Hashtbl.add ctx.defined_funs fid ();
@@ -336,7 +346,7 @@ let define_function ctx fid =
 		| None ->
 		| None ->
 			define ctx "#include <hl/natives.h>"
 			define ctx "#include <hl/natives.h>"
 		| Some f ->
 		| 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);
 			ctx.defines <- sprintf "%s %s(%s);" (ctype ft.fe_ret) ft.fe_name (args_repr ft.fe_args) :: ctx.defines);
 	end;
 	end;
 	ft.fe_name
 	ft.fe_name
@@ -344,18 +354,31 @@ let define_function ctx fid =
 let short_digest str =
 let short_digest str =
 	String.sub (Digest.to_hex (Digest.string str)) 0 7
 	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
 	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_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
 	if String.length s < string_data_limit then
 		sprintf "USTR(\"%s\")" (StringHelper.s_escape s)
 		sprintf "USTR(\"%s\")" (StringHelper.s_escape s)
 	else begin
 	else begin
@@ -364,8 +387,8 @@ let string ctx sid =
 		sprintf "string$%s" id
 		sprintf "string$%s" id
 	end
 	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 sline fmt = Printf.ksprintf line fmt and sexpr fmt = Printf.ksprintf expr fmt in
 
 
 	let funByArgs = Hashtbl.create 0 in
 	let funByArgs = Hashtbl.create 0 in
@@ -400,8 +423,8 @@ let generate_reflection ctx =
 				| _ -> ())
 				| _ -> ())
 			| _ -> ()
 			| _ -> ()
 		) f.code
 		) 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
 	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));
 	sexpr "static int TKIND[] = {%s}" (String.concat "," (List.map (fun t -> string_of_int (type_kind_id (type_kind t))) core_types));
 	line "";
 	line "";
@@ -519,13 +542,13 @@ let generate_reflection ctx =
 	line "}";
 	line "}";
 	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 sline fmt = Printf.ksprintf line fmt and sexpr fmt = Printf.ksprintf expr fmt in
 	let define fmt = Printf.ksprintf (define ctx) fmt in
 	let define fmt = Printf.ksprintf (define ctx) fmt in
 	let block() = block ctx and unblock() = unblock ctx 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 rid = ref (-1) in
 	let cl_id = ref 0 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
 	let label p = sprintf "label$%s%d_%d" ctx.file_prefix ctx.fun_index p in
 	ctx.fun_index <- ctx.fun_index + 1;
 	ctx.fun_index <- ctx.fun_index + 1;
 	Hashtbl.add ctx.defined_funs f.findex ();
 	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 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 rcast r t =
 		let rt = (rtype r) in
 		let rt = (rtype r) in
@@ -567,7 +590,7 @@ let generate_function ctx f =
 	in
 	in
 
 
 	let ocall r fid args =
 	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
 		let rstr = rassign r ft.fe_ret in
 		sexpr "%s%s(%s)" rstr (funname fid) (String.concat "," (List.map2 rcast args ft.fe_args))
 		sexpr "%s%s(%s)" rstr (funname fid) (String.concat "," (List.map2 rcast args ft.fe_args))
 	in
 	in
@@ -582,7 +605,7 @@ let generate_function ctx f =
 	in
 	in
 
 
 	let type_value_opt t =
 	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
 	in
 
 
 	let dyn_call r f pl =
 	let dyn_call r f pl =
@@ -596,7 +619,7 @@ let generate_function ctx f =
 				if is_dynamic t then
 				if is_dynamic t then
 					sprintf "(vdynamic*)%s" (reg p)
 					sprintf "(vdynamic*)%s" (reg p)
 				else
 				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));
 		) pl));
 		let rt = rtype r in
 		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
 		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 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 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
 				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);
 				if rt <> HVoid && not (is_ptr rt) then sexpr "%s = (%s)ret.v.%s" (reg r) (ctype rt) (dyn_prefix rt);
 				unblock();
 				unblock();
 				sline "}"
 				sline "}"
@@ -644,7 +667,7 @@ let generate_function ctx f =
 			sexpr "%s->%s = %s" (reg obj) (obj_field fid name) (rcast v t)
 			sexpr "%s->%s = %s" (reg obj) (obj_field fid name) (rcast v t)
 		| HVirtual vp ->
 		| HVirtual vp ->
 			let name, nid, t = vp.vfields.(fid) in
 			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
 			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__
 			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)
 			sexpr "%s%s->%s" (rassign r t) (reg obj) (obj_field fid name)
 		| HVirtual v ->
 		| HVirtual v ->
 			let name, nid, t = v.vfields.(fid) in
 			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
 			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__
 			Globals.die "" __LOC__
@@ -698,8 +721,8 @@ let generate_function ctx f =
 		| OEndTrap true ->
 		| OEndTrap true ->
 			decr trap_depth
 			decr trap_depth
 		| OStaticClosure (_, fid) ->
 		| 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;
 			incr cl_id;
 		| _ ->
 		| _ ->
 			()
 			()
@@ -819,10 +842,10 @@ let generate_function ctx f =
 		| OBool (r,b) ->
 		| OBool (r,b) ->
 			sexpr "%s = %s" (reg r) (if b then "true" else "false")
 			sexpr "%s = %s" (reg r) (if b then "true" else "false")
 		| OBytes (r,idx) ->
 		| 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) ->
 		| OString (r,idx) ->
-			sexpr "%s = (vbyte*)%s" (reg r) (string ctx idx)
+			sexpr "%s = (vbyte*)%s" (reg r) (string gctx ctx idx)
 		| ONull r ->
 		| ONull r ->
 			sexpr "%s = NULL" (reg r)
 			sexpr "%s = NULL" (reg r)
 		| OAdd (r,a,b) ->
 		| OAdd (r,a,b) ->
@@ -903,22 +926,22 @@ let generate_function ctx f =
 			sexpr "%s = &cl$%d" (reg r) (!cl_id);
 			sexpr "%s = &cl$%d" (reg r) (!cl_id);
 			incr cl_id
 			incr cl_id
 		| OInstanceClosure (r,fid,ptr) ->
 		| 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) ->
 		| OVirtualClosure (r,o,m) ->
 			(match rtype o with
 			(match rtype o with
 			| HObj p ->
 			| 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
 				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())
 				todo())
 		| OGetGlobal (r,g) ->
 		| 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) ->
 		| 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 ->
 		| ORet r ->
 			if rtype r = HVoid then expr "return" else sexpr "return %s" (rcast r fret)
 			if rtype r = HVoid then expr "return" else sexpr "return %s" (rcast r fret)
 		| OJTrue (r,d) | OJNotNull (r,d) ->
 		| 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);
 				sline "if( %s == NULL ) %s = NULL; else {" (reg v) (reg r);
 				block();
 				block();
 			end;
 			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
 			(match rtype v with
 			| HUI8 | HUI16 | HI32 | HBool ->
 			| HUI8 | HUI16 | HI32 | HBool ->
 				sexpr "%s->v.i = %s" (reg r) (reg v)
 				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)
 			sexpr "%s = (int)%s" (reg r) (reg v)
 		| ONew r ->
 		| ONew r ->
 			(match rtype r with
 			(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)
 			| 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__)
 			| _ -> Globals.die "" __LOC__)
 		| OField (r,obj,fid) ->
 		| OField (r,obj,fid) ->
 			get_field r obj fid
 			get_field r obj fid
@@ -1030,13 +1053,13 @@ let generate_function ctx f =
 			if tsrc = HNull t then
 			if tsrc = HNull t then
 				sexpr "%s = %s ? %s%s : 0" (reg r) (reg v) (reg v) (dyn_value_field t)
 				sexpr "%s = %s ? %s%s : 0" (reg r) (reg v) (reg v) (dyn_value_field t)
 			else
 			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) ->
 		| OUnsafeCast (r,v) ->
 			sexpr "%s = (%s)%s" (reg r) (ctype (rtype r)) (reg v)
 			sexpr "%s = (%s)%s" (reg r) (ctype (rtype r)) (reg v)
 		| OArraySize (r,a) ->
 		| OArraySize (r,a) ->
 			sexpr "%s = %s->size" (reg r) (reg a)
 			sexpr "%s = %s->size" (reg r) (reg a)
 		| OType (r,t) ->
 		| OType (r,t) ->
-			sexpr "%s = %s" (reg r) (type_value t)
+			sexpr "%s = %s" (reg r) (type_value ctx t)
 		| OGetType (r,v) ->
 		| OGetType (r,v) ->
 			sexpr "%s = %s ? ((vdynamic*)%s)->t : &hlt_void" (reg r) (reg v) (reg v)
 			sexpr "%s = %s ? ((vdynamic*)%s)->t : &hlt_void" (reg r) (reg v) (reg v)
 		| OGetTID (r,v) ->
 		| OGetTID (r,v) ->
@@ -1048,36 +1071,36 @@ let generate_function ctx f =
 		| OSetref (r,v) ->
 		| OSetref (r,v) ->
 			sexpr "*%s = %s" (reg r) (reg v)
 			sexpr "*%s = %s" (reg r) (reg v)
 		| OToVirtual (r,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) ->
 		| ODynGet (r,o,sid) ->
 			let t = rtype r in
 			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)
 			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) ->
 		| 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)
 			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) ->
 		| 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 need_tmp = List.mem r rl in
 			let tmp = if not need_tmp then reg r else begin
 			let tmp = if not need_tmp then reg r else begin
 				sexpr "{ venum *tmp";
 				sexpr "{ venum *tmp";
 				"tmp"
 				"tmp"
 			end in
 			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
 			let _,_,tl = e.efields.(cid) in
 			list_iteri (fun i v ->
 			list_iteri (fun i v ->
 				sexpr "((%s*)%s)->p%d = %s" et tmp i (rcast v tl.(i))
 				sexpr "((%s*)%s)->p%d = %s" et tmp i (rcast v tl.(i))
 			) rl;
 			) rl;
 			if need_tmp then sexpr "%s = tmp; }" (reg r)
 			if need_tmp then sexpr "%s = tmp; }" (reg r)
 		| OEnumAlloc (r,cid) ->
 		| 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) ->
 		| OEnumIndex (r,v) ->
 			sexpr "%s = HL__ENUM_INDEX__(%s)" (reg r) (reg v)
 			sexpr "%s = HL__ENUM_INDEX__(%s)" (reg r) (reg v)
 		| OEnumField (r,e,cid,pid) ->
 		| 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
 			sexpr "%s((%s*)%s)->p%d" (rassign r tl.(pid)) tname (reg e) pid
 		| OSetEnumField (e,pid,r) ->
 		| 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)
 			sexpr "((%s*)%s)->p%d = (%s)%s" tname (reg e) pid (ctype tl.(pid)) (reg r)
 		| OSwitch (r,idx,eend) ->
 		| OSwitch (r,idx,eend) ->
 			sline "switch(%s) {" (reg r);
 			sline "switch(%s) {" (reg r);
@@ -1397,9 +1420,9 @@ let make_modules ctx all_types =
 	) (List.rev !all_contexts);
 	) (List.rev !all_contexts);
 	!all_modules
 	!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 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 =
 	let type_name t =
 		match t with
 		match t with
 		| HObj o | HStruct o -> o.pname
 		| HObj o | HStruct o -> o.pname
@@ -1413,23 +1436,24 @@ let generate_module_types ctx m =
 		match t with
 		match t with
 		| HObj o | HStruct o ->
 		| HObj o | HStruct o ->
 			let name = tname o.pname in
 			let name = tname o.pname in
+			let td_name = tname ("_" ^ o.pname) in
 			ctx.defined_types <- PMap.add t () ctx.defined_types;
 			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;
 	) types;
 	line "";
 	line "";
 	List.iter (fun t ->
 	List.iter (fun t ->
 		match t with
 		match t with
 		| HObj op | HStruct op ->
 		| HObj op | HStruct op ->
-			let name = tname op.pname in
-			line ("struct _" ^ name ^ " {");
+			let name = tname ("_" ^ op.pname) in
+			line ("struct " ^ name ^ " {");
 			block ctx;
 			block ctx;
 			let rec loop o =
 			let rec loop o =
 				(match o.psuper with
 				(match o.psuper with
 				| None ->
 				| None ->
 					if not (is_struct t) then expr ("hl_type *$type");
 					if not (is_struct t) then expr ("hl_type *$type");
 				| Some c ->
 				| 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);
 					loop c);
 				Array.iteri (fun i (n,_,t) ->
 				Array.iteri (fun i (n,_,t) ->
 					let rec abs_index p v =
 					let rec abs_index p v =
@@ -1437,7 +1461,7 @@ let generate_module_types ctx m =
 						| None -> v
 						| None -> v
 						| Some o -> abs_index o.psuper (Array.length o.pfields + v)
 						| Some o -> abs_index o.psuper (Array.length o.pfields + v)
 					in
 					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)
 					expr (var_type (if n = "" then unamed_field (abs_index o.psuper i) else n) t)
 				) o.pfields;
 				) o.pfields;
 			in
 			in
@@ -1451,11 +1475,11 @@ let generate_module_types ctx m =
 					block ctx;
 					block ctx;
 					line "HL__ENUM_CONSTRUCT__";
 					line "HL__ENUM_CONSTRUCT__";
 					Array.iteri (fun i t ->
 					Array.iteri (fun i t ->
-						define_type ctx t;
+						define_type gctx ctx t;
 						expr (var_type ("p" ^ string_of_int i) t)
 						expr (var_type ("p" ^ string_of_int i) t)
 					) pl;
 					) pl;
 					unblock ctx;
 					unblock ctx;
-					sexpr "} %s" (enum_constr_type ctx e i);
+					sexpr "} %s" (enum_constr_type gctx ctx e i);
 				end;
 				end;
 			) e.efields
 			) e.efields
 		| _ ->
 		| _ ->
@@ -1464,43 +1488,36 @@ let generate_module_types ctx m =
 	line "#endif";
 	line "#endif";
 	line ""
 	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 all_types, htypes = gather_types code in
 	let types_ids = make_types_idents htypes in
 	let types_ids = make_types_idents htypes in
 	let gnames = make_global_names code gnames 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 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;
 		version = com.Gctx.version.version;
-		out = Buffer.create 1024;
-		tabs = "";
 		hlcode = code;
 		hlcode = code;
+		hash_mutex = Mutex.create();
 		hash_cache = Hashtbl.create 0;
 		hash_cache = Hashtbl.create 0;
 		hash_mem = Hashtbl.create 0;
 		hash_mem = Hashtbl.create 0;
 		hash_cache_list = [];
 		hash_cache_list = [];
 		dir = (match Filename.dirname file with "" -> "." | dir -> String.concat "/" (ExtString.String.nsplit dir "\\"));
 		dir = (match Filename.dirname file with "" -> "." | dir -> String.concat "/" (ExtString.String.nsplit dir "\\"));
-		curfile = "";
 		cfiles = [];
 		cfiles = [];
 		ftable = make_function_table code;
 		ftable = make_function_table code;
 		htypes = types_ids;
 		htypes = types_ids;
 		gnames = gnames;
 		gnames = gnames;
 		bytes_names = bnames;
 		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;
 		type_module = PMap.empty;
 		gcon = com;
 		gcon = com;
 	} in
 	} 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 "#ifndef HL_NATIVES_H";
 	define ctx "#define HL_NATIVES_H";
 	define ctx "#define HL_NATIVES_H";
 	define ctx "// Abstract decls";
 	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;
 	List.iter (fun name -> define ctx (sprintf "typedef struct _%s %s;" name name)) abstracts;
 	define ctx "";
 	define ctx "";
 	line "// Natives functions";
 	line "// Natives functions";
-	let native_libs = Hashtbl.create 0 in
 	let sorted_natives = Array.copy code.natives 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.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) ->
 	Array.iter (fun (lib,_,_,idx) ->
 		let name = code.strings.(lib) in
 		let name = code.strings.(lib) in
 		let name = if name.[0] = '?' then String.sub name 1 (String.length name - 1) else name in
 		let name = if name.[0] = '?' then String.sub name 1 (String.length name - 1) else name in
 		Hashtbl.replace native_libs name ();
 		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
 		match ft.fe_name with
 		| "hl_tls_get_w" ->
 		| "hl_tls_get_w" ->
 			define ctx "#define hl_tls_get_w(tls) ((vdynamic*)hl_tls_get(tls))";
 			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;
 	) sorted_natives;
 	line "#endif";
 	line "#endif";
 	line "";
 	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 "#define HLC_BOOT";
 	define ctx "#include <hlc.h>";
 	define ctx "#include <hlc.h>";
 	line "// Globals";
 	line "// Globals";
 	Array.iteri (fun i t ->
 	Array.iteri (fun i t ->
 		let name = gnames.(i) in
 		let name = gnames.(i) in
-		define_type ctx t;
+		define_type gctx ctx t;
 		sexpr "%s = 0" (var_type name t)
 		sexpr "%s = 0" (var_type name t)
 	) code.globals;
 	) code.globals;
 	Array.iter (fun (g,fields) ->
 	Array.iter (fun (g,fields) ->
@@ -1551,14 +1571,14 @@ let write_c com file (code:code) gnames =
 			| HI32 ->
 			| HI32 ->
 				Int32.to_string code.ints.(idx)
 				Int32.to_string code.ints.(idx)
 			| HBytes ->
 			| HBytes ->
-				"(vbyte*)" ^ string ctx idx
+				"(vbyte*)" ^ string gctx ctx idx
 			| _ ->
 			| _ ->
 				Globals.die "" __LOC__
 				Globals.die "" __LOC__
 		in
 		in
 		let fields = match t with
 		let fields = match t with
 			| HObj o | HStruct o ->
 			| 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
 				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__
 				Globals.die "" __LOC__
 		in
 		in
@@ -1613,40 +1633,45 @@ let write_c com file (code:code) gnames =
 				output_bytes (output_string ch) (Bytes.to_string bytes);
 				output_bytes (output_string ch) (Bytes.to_string bytes);
 				close_out ch;
 				close_out ch;
 			end;
 			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);
 			output ctx (Printf.sprintf "#%s  include \"%s\"\n" ctx.tabs bytes_file);
 			sexpr "}";
 			sexpr "}";
 		end else begin
 		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);
 			output_bytes (output ctx) (Bytes.to_string bytes);
 			sexpr "}";
 			sexpr "}";
 		end
 		end
 	) code.bytes;
 	) 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 *)
 	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 "#define HLC_BOOT";
 	define ctx "#include <hlc.h>";
 	define ctx "#include <hlc.h>";
 	line "// Types values";
 	line "// Types values";
 	Array.iteri (fun i t ->
 	Array.iteri (fun i t ->
 		match t with
 		match t with
 		| HMethod _ | HFun _ | HVirtual _ ->
 		| 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;
 	) all_types;
 
 
 	line "";
 	line "";
 	line "// Types values data";
 	line "// Types values data";
 	Array.iter (fun t ->
 	Array.iter (fun t ->
 		let field_value (_,name_id,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
 		in
 		match t with
 		match t with
 		| HObj o | HStruct o ->
 		| HObj o | HStruct o ->
-			let name = type_name ctx t in
+			let name = type_name gctx t in
 			let proto_value p =
 			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
 			in
 			let fields =
 			let fields =
 				if Array.length o.pfields = 0 then "NULL" else
 				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.pfields);
 				string_of_int (Array.length o.pproto);
 				string_of_int (Array.length o.pproto);
 				string_of_int (List.length o.pbindings);
 				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;
 				fields;
 				proto;
 				proto;
 				bindings
 				bindings
 			] in
 			] in
 			sexpr "static hl_type_obj obj%s = {%s}" name (String.concat "," ofields);
 			sexpr "static hl_type_obj obj%s = {%s}" name (String.concat "," ofields);
 		| HEnum e ->
 		| HEnum e ->
-			let ename = type_name ctx t in
+			let ename = type_name gctx t in
 			let constr_value cid (name,nid,tl) =
 			let constr_value cid (name,nid,tl) =
 				let tval = if Array.length tl = 0 then "NULL" else
 				let tval = if Array.length tl = 0 then "NULL" else
 					let name = sprintf "econstruct%s_%d" ename cid in
 					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
 					name
 				in
 				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 offsets = if Array.length tl = 0 then "NULL" else
 					let name = sprintf "eoffsets%s_%d" ename cid in
 					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)));
 					sexpr "static int %s[] = {%s}" name (String.concat "," (List.map (fun _ -> "0") (Array.to_list tl)));
 					name
 					name
 				in
 				in
 				let has_ptr = List.exists is_gc_ptr (Array.to_list tl) 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
 			in
 			let constr_name = if Array.length e.efields = 0 then "NULL" else begin
 			let constr_name = if Array.length e.efields = 0 then "NULL" else begin
 				let name = sprintf "econstruct%s" ename in
 				let name = sprintf "econstruct%s" ename in
@@ -1700,13 +1725,13 @@ let write_c com file (code:code) gnames =
 				name;
 				name;
 			end in
 			end in
 			let efields = [
 			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);
 				string_of_int (Array.length e.efields);
 				constr_name
 				constr_name
 			] in
 			] in
 			sexpr "static hl_type_enum enum%s = {%s}" ename (String.concat "," efields);
 			sexpr "static hl_type_enum enum%s = {%s}" ename (String.concat "," efields);
 		| HVirtual v ->
 		| HVirtual v ->
-			let vname = type_name ctx t in
+			let vname = type_name gctx t in
 			let fields_name =
 			let fields_name =
 				if Array.length v.vfields = 0 then "NULL" else
 				if Array.length v.vfields = 0 then "NULL" else
 				let name = sprintf "vfields%s" vname in
 				let name = sprintf "vfields%s" vname in
@@ -1719,13 +1744,13 @@ let write_c com file (code:code) gnames =
 			] in
 			] in
 			sexpr "static hl_type_virtual virt%s = {%s}" vname (String.concat "," vfields);
 			sexpr "static hl_type_virtual virt%s = {%s}" vname (String.concat "," vfields);
 		| HFun (args,ret) | HMethod(args,ret) ->
 		| 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 aname = if args = [] then "NULL" else
 				let name = sprintf "fargs%s" fname in
 				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
 				name
 			in
 			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;
 	) all_types;
@@ -1739,7 +1764,7 @@ let write_c com file (code:code) gnames =
 	sexpr "fdump(&ntypes,4)";
 	sexpr "fdump(&ntypes,4)";
 	let fcount = ref 0 in
 	let fcount = ref 0 in
 	Array.iter (fun t ->
 	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
 		(match t with
 		| HFun _ -> incr fcount
 		| HFun _ -> incr fcount
 		| _ -> ());
 		| _ -> ());
@@ -1749,7 +1774,7 @@ let write_c com file (code:code) gnames =
 	Array.iter (fun t ->
 	Array.iter (fun t ->
 		match t with
 		match t with
 		| HFun _ ->
 		| 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;
 	) all_types;
 	line "#else";
 	line "#else";
@@ -1764,31 +1789,31 @@ let write_c com file (code:code) gnames =
 	Array.iter (fun t ->
 	Array.iter (fun t ->
 		match t with
 		match t with
 		| HObj o | HStruct o ->
 		| HObj o | HStruct o ->
-			let name = type_name ctx t in
+			let name = type_name gctx t in
 			sexpr "obj%s.m = ctx" name;
 			sexpr "obj%s.m = ctx" name;
 			(match o.pclassglobal with
 			(match o.pclassglobal with
 			| None -> ()
 			| None -> ()
 			| Some g ->
 			| Some g ->
-				define_global ctx g;
+				define_global gctx ctx g;
 				sexpr "obj%s.global_value = (void**)&%s" name gnames.(g));
 				sexpr "obj%s.global_value = (void**)&%s" name gnames.(g));
 			sexpr "%s.obj = &obj%s" name name
 			sexpr "%s.obj = &obj%s" name name
 		| HNull r | HRef r | HPacked r ->
 		| 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 ->
 		| HEnum e ->
-			let name = type_name ctx t in
+			let name = type_name gctx t in
 			sexpr "%s.tenum = &enum%s" name name;
 			sexpr "%s.tenum = &enum%s" name name;
 			(match e.eglobal with
 			(match e.eglobal with
 			| None -> ()
 			| None -> ()
 			| Some g ->
 			| Some g ->
-				define_global ctx g;
+				define_global gctx ctx g;
 				sexpr "enum%s.global_value = (void**)&%s" name gnames.(g));
 				sexpr "enum%s.global_value = (void**)&%s" name gnames.(g));
 			sexpr "hl_init_enum(&%s,ctx)" name;
 			sexpr "hl_init_enum(&%s,ctx)" name;
 		| HVirtual _ ->
 		| HVirtual _ ->
-			let name = type_name ctx t in
+			let name = type_name gctx t in
 			sexpr "%s.virt = &virt%s" name name;
 			sexpr "%s.virt = &virt%s" name name;
 			sexpr "hl_init_virtual(&%s,ctx)" name;
 			sexpr "hl_init_virtual(&%s,ctx)" name;
 		| HFun _ | HMethod _ ->
 		| HFun _ | HMethod _ ->
-			let name = type_name ctx t in
+			let name = type_name gctx t in
 			sexpr "%s.fun = &tfun%s" name name
 			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)";
 	sexpr "hl_gc_set_dump_types(dump_types)";
 	unblock ctx;
 	unblock ctx;
 	line "}";
 	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 "#define HLC_BOOT";
 	define ctx "#include <hlc.h>";
 	define ctx "#include <hlc.h>";
 	line "// Reflection helpers";
 	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
 		let defined_types = ref PMap.empty in
 		if m.m_types <> [] then begin
 		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;
 			defined_types := ctx.defined_types;
+			close_file ctx;
 		end;
 		end;
 		if m.m_functions <> [] then begin
 		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;
 			ctx.defined_types <- !defined_types;
 			define ctx "#define HLC_BOOT";
 			define ctx "#define HLC_BOOT";
 			define ctx "#include <hlc.h>";
 			define ctx "#include <hlc.h>";
@@ -1825,47 +1869,61 @@ let write_c com file (code:code) gnames =
 					("",0)
 					("",0)
 			in
 			in
 			let funcs = List.sort (fun f1 f2 -> compare (file_pos f1) (file_pos f2)) m.m_functions 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;
 		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 "#define HLC_BOOT";
 	define ctx "#include <hlc.h>";
 	define ctx "#include <hlc.h>";
 	sexpr "void *hl_functions_ptrs[] = {%s}" (String.concat ",\\\n\t" (List.map (fun f ->
 	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
 		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 =
 	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);
 		define ctx (sprintf "extern hl_type %s;" n);
 		("&" ^ n) :: loop (i + 1)
 		("&" ^ n) :: loop (i + 1)
 	in
 	in
 	sexpr "hl_type *hl_functions_types[] = {%s}" (String.concat ",\\\n\t" (loop 0));
 	sexpr "hl_type *hl_functions_types[] = {%s}" (String.concat ",\\\n\t" (loop 0));
 	line "";
 	line "";
 	Array.iter (fun f ->
 	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 "#define HLC_BOOT";
 	define ctx "#include <hlc.h>";
 	define ctx "#include <hlc.h>";
 	line "";
 	line "";
 	line "void hl_init_hashes() {";
 	line "void hl_init_hashes() {";
 	block ctx;
 	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;
 	unblock ctx;
 	line "}";
 	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 "#define HLC_BOOT";
 	define ctx "#include <hlc.h>";
 	define ctx "#include <hlc.h>";
 	line "#include <hlc_main.c>";
 	line "#include <hlc_main.c>";
 	line "";
 	line "";
 	line "#ifndef HL_MAKE";
 	line "#ifndef HL_MAKE";
-	List.iter (sline "#  include <%s>") ctx.cfiles;
+	List.iter (sline "#  include <%s>") gctx.cfiles;
 	line "#endif";
 	line "#endif";
 	line "";
 	line "";
 	expr "void hl_init_hashes()";
 	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_types(&ctx)";
 	expr "hl_init_hashes()";
 	expr "hl_init_hashes()";
 	expr "hl_init_roots()";
 	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;
 	unblock ctx;
 	line "}";
 	line "}";
 	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 "{";
 	line "{";
 	block ctx;
 	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 []));
 	sline "\"libs\" : [%s]," (String.concat "," (Hashtbl.fold (fun k _ acc -> sprintf "\"%s\"" k :: acc) native_libs []));
 	let defines = Buffer.create 64 in
 	let defines = Buffer.create 64 in
 	PMap.iter (fun key value ->
 	PMap.iter (fun key value ->
@@ -1901,8 +1963,8 @@ let write_c com file (code:code) gnames =
 	) com.defines.values;
 	) com.defines.values;
 	Buffer.truncate defines (Buffer.length defines - 1);
 	Buffer.truncate defines (Buffer.length defines - 1);
 	sline "\"defines\" : {%s\n\t}," (Buffer.contents defines);
 	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;
 	unblock ctx;
 	line "}";
 	line "}";
-
-	close_file ctx
+	close_file ctx;
+	);

+ 1 - 0
src/generators/hlcode.ml

@@ -213,6 +213,7 @@ type fundecl = {
 	code : opcode array;
 	code : opcode array;
 	debug : (int * int * Globals.pos) array;
 	debug : (int * int * Globals.pos) array;
 	assigns : (string index * int) array;
 	assigns : (string index * int) array;
+	need_opt : bool;
 }
 }
 
 
 type code = {
 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 nregs = Array.length f.regs in
 	let reg_remap = ctx.r_used_regs <> nregs in
 	let reg_remap = ctx.r_used_regs <> nregs in
 	let assigns = ref f.assigns 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 nargs = (match f.ftype with HFun (args,_) -> List.length args | _ -> Globals.die "" __LOC__) in
 
 
 	let live_bits = ctx.r_live_bits in
 	let live_bits = ctx.r_live_bits in
@@ -620,7 +621,7 @@ let remap_fun ctx f dump get_str old_code =
 	end;
 	end;
 
 
 	(* done *)
 	(* done *)
-	if dump <> None then begin
+	if dump then begin
 		let old_assigns = Hashtbl.create 0 in
 		let old_assigns = Hashtbl.create 0 in
 		let new_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;
 		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;
 		loop 0 ctx.r_root;
 		write "";
 		write "";
 		write "";
 		write "";
-		(match dump with None -> () | Some ch -> IO.flush ch);
 	end;
 	end;
 
 
 	let code = ref f.code in
 	let code = ref f.code in
@@ -739,7 +739,8 @@ let remap_fun ctx f dump get_str old_code =
 			regs := new_regs;
 			regs := new_regs;
 		end;
 		end;
 	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 _optimize (f:fundecl) =
 	let nregs = Array.length f.regs in
 	let nregs = Array.length f.regs in
@@ -1059,8 +1060,8 @@ type cache_elt = {
 let opt_cache = ref PMap.empty
 let opt_cache = ref PMap.empty
 let used_mark = ref 0
 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
 	try
 		let c = PMap.find hxf (!opt_cache) in
 		let c = PMap.find hxf (!opt_cache) in
 		c.c_last_used <- !used_mark;
 		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
 		let fopt = remap_fun rctx f dump get_str old_code in
 		Hashtbl.iter (fun _ b ->
 		Hashtbl.iter (fun _ b ->
 			b.bstate <- None;
 			b.bstate <- None;
-			if dump = None then begin
+			if not dump then begin
 				b.bneed <- ISet.empty;
 				b.bneed <- ISet.empty;
 				b.bneed_all <- None;
 				b.bneed_all <- None;
 			end;
 			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 methods = DynArray.create ()
 	val method_sigs = Hashtbl.create 0
 	val method_sigs = Hashtbl.create 0
 	val inner_classes = 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 closure_ids_per_name = Hashtbl.create 0
 	val mutable spawned_methods = []
 	val mutable spawned_methods = []
 	val mutable static_init_method = None
 	val mutable static_init_method = None
@@ -117,6 +118,12 @@ class builder path_this path_super = object(self)
 		end;
 		end;
 		jc
 		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) =
 	method spawn_method (name : string) (jsig_method : jsignature) (flags : MethodAccessFlags.t list) =
 		let jm = new JvmMethod.builder self name jsig_method in
 		let jm = new JvmMethod.builder self name jsig_method in
 		let ssig_method = generate_method_signature false 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
 	| CObject -> object_path_sig object_path
 
 
 class typed_functions = object(self)
 class typed_functions = object(self)
+	val signature_mutex = Mutex.create ()
 	val signatures = Hashtbl.create 0
 	val signatures = Hashtbl.create 0
 	val mutable max_arity = 0
 	val mutable max_arity = 0
 
 
@@ -80,10 +81,27 @@ class typed_functions = object(self)
 		(cl : signature_classification list)
 		(cl : signature_classification list)
 		(cr : signature_classification option)
 		(cr : signature_classification option)
 	=
 	=
-		try
+		Mutex.lock signature_mutex;
+		let meth = try
 			Hashtbl.find signatures (cl,cr)
 			Hashtbl.find signatures (cl,cr)
 		with Not_found ->
 		with Not_found ->
 			self#do_register_signature cl cr
 			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
 	method private do_register_signature
 		(cl : signature_classification list)
 		(cl : signature_classification list)
@@ -107,19 +125,6 @@ class typed_functions = object(self)
 		} in
 		} in
 		if meth.arity > max_arity then max_arity <- meth.arity;
 		if meth.arity > max_arity then max_arity <- meth.arity;
 		Hashtbl.add signatures (meth.cargs,meth.cret) meth;
 		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
 		meth
 
 
 	method make_forward_method_jsig
 	method make_forward_method_jsig
@@ -341,6 +346,7 @@ class typed_function
 				Printf.sprintf "%s_%s" (snd path) (patch_name name)
 				Printf.sprintf "%s_%s" (snd path) (patch_name name)
 		in
 		in
 		let jc = host_class#spawn_inner_class None haxe_function_path (Some 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#add_access_flag 0x10; (* final *)
 		jc
 		jc
 
 

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

@@ -34,9 +34,9 @@ type scope = {
 	(* The local start offset of the current scope. *)
 	(* The local start offset of the current scope. *)
 	local_offset : int;
 	local_offset : int;
 	(* The locals declared in the current scope. Maps variable IDs to local slots. *)
 	(* 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. *)
 	(* 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. *)
 	(* The IDs of local variables. Maps variable names to variable IDs. *)
 	local_ids : (string,int) Hashtbl.t;
 	local_ids : (string,int) Hashtbl.t;
 }
 }
@@ -59,7 +59,7 @@ type env_info = {
 	(* The environment kind. *)
 	(* The environment kind. *)
 	kind : env_kind;
 	kind : env_kind;
 	(* The name of capture variables. Maps local slots to variable names. Only filled in debug mode. *)
 	(* 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. *)
 	(* The number of local variables. *)
 	num_locals : int;
 	num_locals : int;
 	(* The number of capture variables. *)
 	(* The number of capture variables. *)
@@ -114,7 +114,7 @@ and eval = {
 	(* The currently active breakpoint. Set to a dummy value initially. *)
 	(* The currently active breakpoint. Set to a dummy value initially. *)
 	mutable breakpoint : breakpoint;
 	mutable breakpoint : breakpoint;
 	(* Map of all types that are currently being caught. Updated by `emit_try`. *)
 	(* 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. *)
 	(* The most recently caught exception. Used by `debug_loop` to avoid getting stuck. *)
 	mutable caught_exception : value;
 	mutable caught_exception : value;
 	(* The value which was last returned. *)
 	(* The value which was last returned. *)
@@ -156,8 +156,8 @@ type function_breakpoint = {
 type builtins = {
 type builtins = {
 	mutable instance_builtins : (int * value) list IntMap.t;
 	mutable instance_builtins : (int * value) list IntMap.t;
 	mutable static_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 = {
 type debug_scope_info = {
@@ -168,7 +168,7 @@ type debug_scope_info = {
 type context_reference =
 type context_reference =
 	| StackFrame of env
 	| StackFrame of env
 	| Scope of scope * 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
 	| DebugScope of debug_scope_info * env
 	| Value of value * env
 	| Value of value * env
 	| Toplevel
 	| Toplevel
@@ -249,7 +249,7 @@ and debug_socket = {
 (* Per-context debug information *)
 (* Per-context debug information *)
 and debug = {
 and debug = {
 	(* The registered breakpoints *)
 	(* The registered breakpoints *)
-	breakpoints : (int,(int,breakpoint) Hashtbl.t) Hashtbl.t;
+	breakpoints : breakpoint IntHashtbl.t IntHashtbl.t;
 	(* The registered function breakpoints *)
 	(* The registered function breakpoints *)
 	function_breakpoints : ((int * int),function_breakpoint) Hashtbl.t;
 	function_breakpoints : ((int * int),function_breakpoint) Hashtbl.t;
 	(* Whether or not debugging is supported. Has various effects on the amount of
 	(* 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 curapi : value MacroApi.compiler_api;
 	mutable type_cache : Type.module_type IntMap.t;
 	mutable type_cache : Type.module_type IntMap.t;
 	overrides : (Globals.path * string,bool) Hashtbl.t;
 	overrides : (Globals.path * string,bool) Hashtbl.t;
+	timer_ctx : Timer.timer_context;
 	(* prototypes *)
 	(* prototypes *)
 	mutable array_prototype : vprototype;
 	mutable array_prototype : vprototype;
 	mutable string_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 push_environment ctx info =
 	let eval = get_eval ctx in
 	let eval = get_eval ctx in
 	let timer = if ctx.detail_times then
 	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
 	else
 		no_timer
 		no_timer
 	in
 	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
 	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 =
 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 =
 let get_proto_field_index_raise proto name =
 	IntMap.find name proto.pnames
 	IntMap.find name proto.pnames

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

@@ -1,3 +1,4 @@
+open Globals
 open Type
 open Type
 open EvalJitContext
 open EvalJitContext
 open EvalContext
 open EvalContext
@@ -7,7 +8,7 @@ open EvalDebugMisc
 
 
 let is_caught eval v =
 let is_caught eval v =
 	try
 	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
 		false
 	with Exit ->
 	with Exit ->
 		true
 		true
@@ -72,8 +73,8 @@ let debug_loop jit conn e f =
 	let rec run_check_breakpoint env =
 	let rec run_check_breakpoint env =
 		let eval = env.env_eval in
 		let eval = env.env_eval in
 		try
 		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
 			begin match breakpoint.bpstate with
 				| BPEnabled when column_matches breakpoint && condition_holds env breakpoint ->
 				| BPEnabled when column_matches breakpoint && condition_holds env breakpoint ->
 					breakpoint.bpstate <- BPHit;
 					breakpoint.bpstate <- BPHit;

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

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

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

@@ -225,7 +225,7 @@ let output_scopes ctx env =
 		JObject fl
 		JObject fl
 	in
 	in
 	let scopes = List.fold_left (fun acc scope ->
 	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
 			(mk_scope (ctx.debug.debug_context#add_scope scope env) "Locals" scope.pos) :: acc
 		else
 		else
 			acc
 			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
 		(mk_scope (ctx.debug.debug_context#add_debug_scope dbg env) "Eval" null_pos) :: scopes
 	end in
 	end in
 	let scopes = List.rev scopes 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
 	JArray scopes
 
 
 let output_capture_vars infos env =
 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
 		let value = (env.env_captures.(slot)) in
 		(var_to_json vi.vi_name value (Some vi) env) :: acc
 		(var_to_json vi.vi_name value (Some vi) env) :: acc
 	) infos [] in
 	) infos [] in
@@ -259,7 +259,7 @@ let output_debug_scope dbg env =
 
 
 let output_scope_vars env scope =
 let output_scope_vars env scope =
 	let p = env.env_debug.debug_pos in
 	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
 		if declared_before vi p then begin
 			let slot = local_slot + scope.local_offset in
 			let slot = local_slot + scope.local_offset in
 			let value = env.env_locals.(slot) in
 			let value = env.env_locals.(slot) in
@@ -312,7 +312,7 @@ let output_inner_vars v env =
 				n, v
 				n, v
 			) l
 			) l
 		| VInstance {ikind = IStringMap h} ->
 		| VInstance {ikind = IStringMap h} ->
-			StringHashtbl.fold (fun s (_,v) acc ->
+			RuntimeStringHashtbl.fold (fun s (_,v) acc ->
 				(s,v) :: acc
 				(s,v) :: acc
 			) h []
 			) h []
 		| VInstance {ikind = IMutex mutex} ->
 		| VInstance {ikind = IMutex mutex} ->
@@ -384,7 +384,7 @@ module ValueCompletion = struct
 		in
 		in
 		loop env.env_debug.scopes;
 		loop env.env_debug.scopes;
 		(* 2. Captures *)
 		(* 2. Captures *)
-		Hashtbl.iter (fun slot vi ->
+		IntHashtbl.iter (fun slot vi ->
 			add (hash vi.vi_name) "variable"
 			add (hash vi.vi_name) "variable"
 		) env.env_info.capture_infos;
 		) env.env_info.capture_infos;
 		(* 3. Instance *)
 		(* 3. Instance *)
@@ -475,18 +475,18 @@ module ValueCompletion = struct
 	let get_completion ctx text column env =
 	let get_completion ctx text column env =
 		let p = file_pos "" in
 		let p = file_pos "" in
 		let save =
 		let save =
-			let old = !Parser.display_mode,DisplayPosition.display_position#get in
+			let old = DisplayPosition.display_position#get in
 			(fun () ->
 			(fun () ->
-				Parser.display_mode := fst old;
-				DisplayPosition.display_position#set (snd old);
+				DisplayPosition.display_position#set old;
 			)
 			)
 		in
 		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
 		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};
 		DisplayPosition.display_position#set {p with pmin = offset; pmax = offset};
 		begin try
 		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();
 			save();
 			let rec loop e = match fst e with
 			let rec loop e = match fst e with
 			| EDisplay(e1,DKDot) ->
 			| EDisplay(e1,DKDot) ->
@@ -542,6 +542,9 @@ let expect_env hctx env = match env with
 	| None -> hctx.send_error "No frame found"
 	| None -> hctx.send_error "No frame found"
 
 
 let handler =
 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 parse_breakpoint hctx jo =
 		let j = hctx.jsonrpc in
 		let j = hctx.jsonrpc in
 		let obj = j#get_object "breakpoint" jo 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 hash = hash (Path.UniqueKey.to_string (hctx.ctx.file_keys#get (Common.find_file (hctx.ctx.curapi.get_com()) file))) in
 			let h =
 			let h =
 				try
 				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
 					h
 				with Not_found ->
 				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
 					h
 			in
 			in
 			let bps = List.map (fun (line,column,condition) ->
 			let bps = List.map (fun (line,column,condition) ->
 				let bp = make_breakpoint hash line BPEnabled column condition in
 				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]
 				JObject ["id",JInt bp.bpid]
 			) bps in
 			) bps in
 			JArray bps
 			JArray bps
@@ -685,10 +688,10 @@ let handler =
 		"removeBreakpoint",(fun hctx ->
 		"removeBreakpoint",(fun hctx ->
 			let id = hctx.jsonrpc#get_int_param "id" in
 			let id = hctx.jsonrpc#get_int_param "id" in
 			begin try
 			begin try
-				Hashtbl.iter (fun _ h ->
+				IntHashtbl.iter (fun _ h ->
 					let to_delete = ref [] in
 					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;
 				) hctx.ctx.debug.breakpoints;
 			with Not_found ->
 			with Not_found ->
 				hctx.send_error (Printf.sprintf "Unknown breakpoint: %d" id)
 				hctx.send_error (Printf.sprintf "Unknown breakpoint: %d" id)
@@ -726,7 +729,7 @@ let handler =
 			| Scope(scope,env) ->
 			| Scope(scope,env) ->
 				let value = get_value env in
 				let value = get_value env in
 				let id = Hashtbl.find scope.local_ids name 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;
 				env.env_locals.(slot + scope.local_offset) <- value;
 				var_to_json "" value None env
 				var_to_json "" value None env
 			| CaptureScope(infos,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 ctx = get_ctx() in
 	let eval = env.env_eval in
 	let eval = env.env_eval in
 	if ctx.debug.support_debugger then begin
 	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;
 	end;
 	let restore () =
 	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
 	in
 	let v = try
 	let v = try
 		let v = handle_stack_overflow eval (fun() -> exec env) in
 		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))
 	create_cached_instance key_haxe_ds_ObjectMap (fun (s : value ValueHashtbl.t) -> IObjectMap (Obj.magic s))
 
 
 let encode_string_map convert m =
 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
 	encode_string_map_direct h
 
 
 let fake_proto path =
 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 fl,exec = jit_tfunction jit_closure true e.epos tf in
 		let hasret = jit_closure.has_nonfinal_return 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 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
 		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. *)
 		(* 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;
 		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) ->
 		let captures = ExtList.List.filter_map (fun (i,vid,declared) ->
 			if declared then None
 			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
 		) captures in
 		let mapping = Array.of_list captures in
 		let mapping = Array.of_list captures in
 		emit_closure ctx mapping eci hasret exec fl
 		emit_closure ctx mapping eci hasret exec fl
@@ -696,10 +696,10 @@ and jit_tfunction jit static pos tf =
 	fl,exec
 	fl,exec
 
 
 and get_env_creation jit static file info =
 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 =
 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. *)
 (* Creates a [EvalValue.vfunc] of function [tf], which can be [static] or not. *)
 let jit_tfunction ctx key_type key_field tf static pos =
 let jit_tfunction ctx key_type key_field tf static pos =

이 변경점에서 너무 많은 파일들이 변경되어 몇몇 파일들은 표시되지 않았습니다.