From bc0a098e965414391cc14f0e3fa3a81c6b6ded64 Mon Sep 17 00:00:00 2001 From: Andy Li Date: Fri, 12 Feb 2021 12:59:00 +0800 Subject: [PATCH] New upstream version 4.2.0 --- .github/workflows/main.yml | 918 +++++++ .vscode/schemas/define.schema.json | 4 + CONTRIBUTING.md | 2 +- Makefile | 2 +- README.md | 2 +- azure-pipelines.yml | 318 --- extra/CHANGES.txt | 79 +- extra/ImportAll.hx | 2 +- extra/all.hxml | 3 +- extra/azure-pipelines/build-linux.yml | 61 - extra/azure-pipelines/build-mac.yml | 50 - extra/azure-pipelines/build-windows.yml | 71 - .../install-neko-snapshot.yaml | 33 - extra/azure-pipelines/test-windows.yml | 87 - extra/github-actions/Main.hx | 46 + extra/github-actions/build-linux.yml | 61 + extra/github-actions/build-mac.yml | 44 + extra/github-actions/build-windows.yml | 61 + extra/github-actions/build.hxml | 2 + extra/github-actions/install-neko.yml | 27 + extra/github-actions/test-linux.yml | 46 + extra/github-actions/test-mac.yml | 32 + extra/github-actions/test-windows.yml | 48 + extra/github-actions/workflows/main.yml | 300 ++ libs/README.md | 5 - libs/extc/process_stubs.c | 94 +- libs/extlib-leftovers/base64.ml | 130 + libs/extlib-leftovers/base64.mli | 65 + libs/extlib-leftovers/dune | 2 +- libs/ilib/ilMetaReader.ml | 7 +- libs/ilib/peData.ml | 2 + libs/ilib/peDataDebug.ml | 2 + libs/ilib/peReader.ml | 2 + libs/ilib/peWriter.ml | 2 + libs/javalib/jData.ml | 21 +- libs/javalib/jReader.ml | 57 +- libs/javalib/jWriter.ml | 10 + libs/swflib/as3.mli | 1 + libs/swflib/as3code.ml | 1 + libs/swflib/as3hl.mli | 1 + libs/swflib/as3hlparse.ml | 1 + libs/swflib/as3parse.ml | 1 + libs/ttflib/tTFTools.ml | 2 +- opam | 5 +- src-json/define.json | 60 +- src-json/meta.json | 45 +- src/codegen/codegen.ml | 99 +- src/codegen/dotnet.ml | 37 +- .../gencommon/abstractImplementationFix.ml | 2 +- src/codegen/gencommon/castDetect.ml | 79 +- src/codegen/gencommon/closuresToClass.ml | 33 +- src/codegen/gencommon/enumToClass.ml | 4 +- src/codegen/gencommon/enumToClass2.ml | 6 +- src/codegen/gencommon/fixOverrides.ml | 28 +- src/codegen/gencommon/gencommon.ml | 82 +- src/codegen/gencommon/initFunction.ml | 8 +- src/codegen/gencommon/interfaceProps.ml | 2 +- .../gencommon/interfaceVarsDeleteModf.ml | 2 +- src/codegen/gencommon/normalize.ml | 4 +- .../gencommon/overloadingConstructor.ml | 10 +- src/codegen/gencommon/realTypeParams.ml | 19 +- src/codegen/gencommon/reflectionCFs.ml | 35 +- src/codegen/gencommon/setHXGen.ml | 2 +- src/codegen/genxml.ml | 16 +- src/codegen/java.ml | 107 +- src/codegen/javaModern.ml | 1032 +++++++ src/codegen/overloads.ml | 197 +- src/codegen/swfLoader.ml | 7 +- src/compiler/displayOutput.ml | 18 +- src/compiler/haxe.ml | 31 +- src/compiler/server.ml | 19 +- src/compiler/serverMessage.ml | 2 +- src/context/abstractCast.ml | 150 +- src/context/common.ml | 177 +- src/context/compilationServer.ml | 2 +- src/context/display/deprecationCheck.ml | 7 +- src/context/display/diagnostics.ml | 24 +- src/context/display/diagnosticsPrinter.ml | 104 +- src/context/display/diagnosticsTypes.ml | 10 - src/context/display/display.ml | 20 +- src/context/display/displayEmitter.ml | 15 +- src/context/display/displayException.ml | 58 +- src/context/display/displayFields.ml | 136 +- src/context/display/displayJson.ml | 9 +- src/context/display/displayPath.ml | 2 +- src/context/display/displayTexpr.ml | 19 +- src/context/display/displayToplevel.ml | 17 +- src/context/display/documentSymbols.ml | 49 +- src/context/display/statistics.ml | 42 +- src/context/display/syntaxExplorer.ml | 13 +- src/context/nativeLibraryHandler.ml | 14 +- src/context/sourcemaps.ml | 2 +- src/context/typecore.ml | 133 +- src/core/abstract.ml | 142 +- src/core/ast.ml | 139 +- src/core/display/completionItem.ml | 54 +- src/core/display/displayPosition.ml | 9 +- src/core/display/javadoc.ml | 148 + src/core/displayTypes.ml | 78 +- src/core/error.ml | 13 +- src/core/globals.ml | 2 +- src/core/inheritDoc.ml | 231 ++ src/core/json/genjson.ml | 88 +- src/core/path.ml | 129 +- src/core/tFunctions.ml | 155 +- src/core/tOther.ml | 38 +- src/core/tPrinting.ml | 38 +- src/core/tType.ml | 65 +- src/core/tUnification.ml | 824 ++++-- src/core/texpr.ml | 7 +- src/core/timer.ml | 22 +- src/core/withType.ml | 27 +- src/dune | 3 +- src/filters/ES6Ctors.ml | 2 +- src/filters/capturedVars.ml | 27 +- src/filters/exceptions.ml | 5 +- src/filters/filters.ml | 98 +- src/filters/filtersCommon.ml | 14 +- src/filters/renameVars.ml | 28 +- src/filters/tre.ml | 2 +- src/filters/varLazifier.ml | 11 + src/generators/flashProps.ml | 4 +- src/generators/gencpp.ml | 416 ++- src/generators/gencs.ml | 164 +- src/generators/genhl.ml | 93 +- src/generators/genhxold.ml | 20 +- src/generators/genjava.ml | 95 +- src/generators/genjs.ml | 263 +- src/generators/genjvm.ml | 662 +++-- src/generators/genlua.ml | 78 +- src/generators/genneko.ml | 21 +- src/generators/genphp7.ml | 397 ++- src/generators/genpy.ml | 31 +- src/generators/genshared.ml | 362 +-- src/generators/genswf.ml | 4 +- src/generators/genswf9.ml | 174 +- src/generators/hlinterp.ml | 1 + src/generators/jvm/jvmClass.ml | 13 +- src/generators/jvm/jvmCode.ml | 59 +- src/generators/jvm/jvmConstantPool.ml | 2 +- src/generators/jvm/jvmDebug.ml | 281 -- src/generators/jvm/jvmFunctions.ml | 52 +- src/generators/jvm/jvmGlobals.ml | 7 +- src/generators/jvm/jvmMethod.ml | 46 +- src/generators/jvm/jvmSignature.ml | 7 + src/macro/eval/EvalStackTrace.ml | 46 + src/macro/eval/evalContext.ml | 54 +- src/macro/eval/evalDebugMisc.ml | 14 +- src/macro/eval/evalDebugSocket.ml | 23 +- src/macro/eval/evalDecode.ml | 20 +- src/macro/eval/evalEmitter.ml | 5 + src/macro/eval/evalEncode.ml | 38 +- src/macro/eval/evalExceptions.ml | 51 +- src/macro/eval/evalHash.ml | 60 + src/macro/eval/evalIntegers.ml | 270 ++ src/macro/eval/evalJit.ml | 65 +- src/macro/eval/evalJitContext.ml | 4 +- src/macro/eval/evalLuv.ml | 2431 +++++++++++++++++ src/macro/eval/evalMain.ml | 60 +- src/macro/eval/evalMisc.ml | 35 + src/macro/eval/evalPrinting.ml | 7 +- src/macro/eval/evalPrototype.ml | 20 +- src/macro/eval/evalStdLib.ml | 272 +- src/macro/eval/evalString.ml | 7 +- src/macro/eval/evalThread.ml | 84 +- src/macro/eval/evalValue.ml | 86 +- src/macro/macroApi.ml | 121 +- src/optimization/analyzer.ml | 50 +- src/optimization/analyzerTexpr.ml | 14 +- src/optimization/analyzerTexprTransformer.ml | 14 +- src/optimization/analyzerTypes.ml | 6 +- src/optimization/dce.ml | 75 +- src/optimization/inline.ml | 69 +- src/optimization/inlineConstructors.ml | 598 ++-- src/optimization/optimizer.ml | 482 +--- src/optimization/optimizerTexpr.ml | 4 +- src/syntax/grammar.mly | 238 +- src/syntax/lexer.ml | 61 +- src/syntax/parser.ml | 84 +- src/syntax/parserEntry.ml | 33 +- src/syntax/reification.ml | 29 +- src/typing/callUnification.ml | 617 +++++ src/typing/calls.ml | 782 ++---- src/typing/fieldAccess.ml | 159 ++ src/typing/fields.ml | 931 +++---- src/typing/finalization.ml | 95 +- src/typing/forLoop.ml | 27 +- src/typing/functionArguments.ml | 153 ++ src/typing/generic.ml | 128 +- src/typing/instanceBuilder.ml | 6 +- src/typing/macroContext.ml | 123 +- src/typing/magicTypes.ml | 44 - src/typing/matcher.ml | 236 +- src/typing/nullSafety.ml | 9 +- src/typing/operators.ml | 942 +++++++ src/typing/overloadResolution.ml | 99 + src/typing/typeload.ml | 165 +- src/typing/typeloadCheck.ml | 240 +- src/typing/typeloadFields.ml | 851 +++--- src/typing/typeloadFunction.ml | 106 +- src/typing/typeloadModule.ml | 189 +- src/typing/typeloadParse.ml | 16 +- src/typing/typer.ml | 1374 ++-------- src/typing/typerBase.ml | 109 +- src/typing/typerDisplay.ml | 110 +- src/typing/typerDotPath.ml | 65 +- std/Any.hx | 1 + std/DateTools.hx | 2 +- std/EReg.hx | 2 +- std/Std.hx | 1 + std/StringTools.hx | 60 +- std/UInt.hx | 1 + std/cpp/NativeArray.hx | 3 + std/cpp/NativeString.hx | 14 + std/cpp/Rest.hx | 25 + std/cpp/Stdio.hx | 2 - std/cpp/_std/Std.hx | 1 + std/cpp/_std/Type.hx | 8 +- std/cpp/_std/haxe/Exception.hx | 2 +- std/cpp/_std/haxe/Int64.hx | 12 +- std/cpp/_std/haxe/Utf8.hx | 2 +- std/cpp/_std/sys/db/Sqlite.hx | 4 +- std/cpp/_std/sys/ssl/Certificate.hx | 2 +- std/cpp/_std/sys/thread/Thread.hx | 160 +- std/cpp/cppia/HostClasses.hx | 11 +- std/cs/Syntax.hx | 56 + std/cs/_std/Std.hx | 1 + std/cs/_std/haxe/Exception.hx | 2 +- std/cs/_std/haxe/Int64.hx | 1 + std/cs/_std/haxe/Rest.hx | 54 + std/cs/_std/sys/net/Host.hx | 17 +- std/cs/_std/sys/net/Socket.hx | 8 + std/cs/_std/sys/net/UdpSocket.hx | 99 + std/cs/_std/sys/thread/Thread.hx | 95 +- std/cs/internal/HxObject.hx | 2 +- std/eval/NativeString.hx | 45 + std/eval/_std/haxe/Exception.hx | 2 +- std/eval/_std/sys/ssl/Socket.hx | 4 +- std/eval/_std/sys/thread/EventLoop.hx | 140 + std/eval/_std/sys/thread/Thread.hx | 51 +- std/eval/integers/Int64.hx | 116 + std/eval/integers/UInt64.hx | 109 + std/eval/luv/Async.hx | 21 + std/eval/luv/Barrier.hx | 23 + std/eval/luv/Buffer.hx | 120 + std/eval/luv/Check.hx | 26 + std/eval/luv/Condition.hx | 39 + std/eval/luv/ConnectedUdp.hx | 34 + std/eval/luv/Dir.hx | 73 + std/eval/luv/Dns.hx | 69 + std/eval/luv/Env.hx | 23 + std/eval/luv/File.hx | 424 +++ std/eval/luv/FsEvent.hx | 36 + std/eval/luv/FsPoll.hx | 30 + std/eval/luv/Handle.hx | 85 + std/eval/luv/Idle.hx | 26 + std/eval/luv/Loop.hx | 93 + std/eval/luv/LuvException.hx | 19 + std/eval/luv/Metrics.hx | 13 + std/eval/luv/Mutex.hx | 35 + std/eval/luv/Network.hx | 36 + std/eval/luv/Once.hx | 18 + std/eval/luv/OsFd.hx | 6 + std/eval/luv/OsSocket.hx | 6 + std/eval/luv/Passwd.hx | 21 + std/eval/luv/Path.hx | 37 + std/eval/luv/Pid.hx | 18 + std/eval/luv/Pipe.hx | 77 + std/eval/luv/Prepare.hx | 26 + std/eval/luv/Process.hx | 89 + std/eval/luv/Random.hx | 26 + std/eval/luv/Request.hx | 13 + std/eval/luv/Resource.hx | 78 + std/eval/luv/Result.hx | 40 + std/eval/luv/RwLock.hx | 48 + std/eval/luv/Semaphore.hx | 33 + std/eval/luv/Signal.hx | 57 + std/eval/luv/SockAddr.hx | 47 + std/eval/luv/Stream.hx | 111 + std/eval/luv/SystemInfo.hx | 39 + std/eval/luv/Tcp.hx | 62 + std/eval/luv/Thread.hx | 34 + std/eval/luv/ThreadPool.hx | 31 + std/eval/luv/Time.hx | 27 + std/eval/luv/Timer.hx | 40 + std/eval/luv/Tty.hx | 63 + std/eval/luv/UVError.hx | 187 ++ std/eval/luv/Udp.hx | 121 + std/eval/luv/Version.hx | 44 + std/eval/vm/NativeThread.hx | 3 + std/flash/Boot.hx | 2 +- std/flash/_std/Std.hx | 1 + std/flash/_std/haxe/Exception.hx | 2 +- std/flash/_std/haxe/zip/Compress.hx | 2 +- std/flash/_std/haxe/zip/Uncompress.hx | 2 +- std/flash/events/KeyboardEvent.hx | 2 +- std/haxe/CallStack.hx | 4 +- std/haxe/EntryPoint.hx | 39 +- std/haxe/Int32.hx | 3 +- std/haxe/Int64.hx | 1 + std/haxe/Log.hx | 2 +- std/haxe/MainLoop.hx | 32 + std/haxe/Rest.hx | 91 + std/haxe/Template.hx | 10 +- std/haxe/Timer.hx | 43 +- std/haxe/Unserializer.hx | 54 +- std/haxe/Utf8.hx | 4 +- std/haxe/display/Display.hx | 6 + std/haxe/display/JsonModuleTypes.hx | 3 + std/haxe/ds/Map.hx | 1 + std/haxe/ds/ReadOnlyArray.hx | 19 +- std/haxe/ds/Vector.hx | 2 +- std/haxe/ds/WeakMap.hx | 2 +- std/haxe/exceptions/ArgumentException.hx | 16 + .../exceptions/NotImplementedException.hx | 10 + std/haxe/exceptions/PosException.hx | 27 + std/haxe/extern/AsVar.hx | 1 + std/haxe/extern/EitherType.hx | 1 + std/haxe/extern/Rest.hx | 8 +- std/haxe/format/JsonParser.hx | 8 +- std/haxe/format/JsonPrinter.hx | 7 +- std/haxe/http/HttpBase.hx | 12 +- std/haxe/http/HttpNodeJs.hx | 4 +- std/haxe/io/Float64Array.hx | 4 +- std/haxe/io/Input.hx | 4 +- std/haxe/io/Output.hx | 2 +- std/haxe/iterators/MapKeyValueIterator.hx | 2 +- std/haxe/iterators/RestIterator.hx | 19 + std/haxe/iterators/RestKeyValueIterator.hx | 19 + std/haxe/iterators/StringIterator.hx | 48 +- std/haxe/iterators/StringIteratorUnicode.hx | 2 +- std/haxe/macro/Compiler.hx | 2 + std/haxe/macro/Expr.hx | 60 +- std/haxe/macro/ExprTools.hx | 3 +- std/haxe/macro/MacroStringTools.hx | 18 +- std/haxe/macro/Printer.hx | 41 +- std/haxe/macro/Type.hx | 16 +- std/haxe/xml/Parser.hx | 11 +- std/haxe/zip/Compress.hx | 4 +- std/haxe/zip/Entry.hx | 2 +- std/haxe/zip/Uncompress.hx | 2 +- std/hl/_std/Std.hx | 1 + std/hl/_std/UInt.hx | 1 + std/hl/_std/haxe/Exception.hx | 2 +- std/hl/_std/haxe/ds/Vector.hx | 2 +- std/hl/_std/sys/db/Sqlite.hx | 2 - std/hl/_std/sys/ssl/Certificate.hx | 2 +- std/hl/_std/sys/ssl/Socket.hx | 2 + std/hl/_std/sys/thread/Thread.hx | 162 +- std/hl/types/ArrayBase.hx | 34 +- std/java/_std/EReg.hx | 23 +- std/java/_std/Std.hx | 1 + std/java/_std/Sys.hx | 6 +- std/java/_std/haxe/Exception.hx | 2 +- std/java/_std/haxe/Int64.hx | 1 + std/java/_std/haxe/Rest.hx | 64 + std/java/_std/haxe/zip/Compress.hx | 4 +- std/java/_std/sys/net/Socket.hx | 6 +- std/java/_std/sys/thread/Thread.hx | 177 +- std/java/db/Jdbc.hx | 7 +- std/java/internal/HxObject.hx | 2 +- std/java/lang/Boolean.hx | 10 +- std/java/lang/Byte.hx | 6 + std/java/lang/Character.hx | 1 + std/java/lang/Double.hx | 6 + std/java/lang/Float.hx | 6 + std/java/lang/Integer.hx | 6 + std/java/lang/Long.hx | 6 + std/java/lang/Short.hx | 6 + std/js/Boot.hx | 4 +- std/js/Browser.hx | 10 +- std/js/_std/Std.hx | 1 + std/js/_std/Type.hx | 21 +- std/js/_std/haxe/ds/StringMap.hx | 98 +- std/js/_std/haxe/io/ArrayBufferView.hx | 2 +- std/js/lib/Object.hx | 3 + std/js/lib/Promise.hx | 38 +- std/js/lib/Proxy.hx | 13 +- std/js/lib/Reflect.hx | 8 + std/jvm/CompiledPattern.hx | 32 + std/jvm/Enum.hx | 4 +- std/jvm/Jvm.hx | 78 +- std/jvm/_std/EReg.hx | 182 ++ std/jvm/_std/Reflect.hx | 4 +- std/jvm/_std/Std.hx | 1 + std/jvm/_std/Type.hx | 8 +- std/jvm/_std/sys/thread/Lock.hx | 28 +- std/jvm/_std/sys/thread/Thread.hx | 107 - std/lua/Boot.hx | 20 +- std/lua/Package.hx | 2 +- std/lua/_lua/_hx_tostring.lua | 17 +- std/lua/_std/Std.hx | 1 + std/lua/_std/Sys.hx | 2 +- std/lua/_std/haxe/Exception.hx | 2 +- std/lua/_std/haxe/Rest.hx | 55 + std/lua/_std/haxe/format/JsonParser.hx | 292 ++ std/lua/lib/hxluasimdjson/Json.hx | 5 + std/neko/Web.hx | 1 - std/neko/_std/Std.hx | 1 + std/neko/_std/haxe/Exception.hx | 2 +- std/neko/_std/sys/db/Sqlite.hx | 8 +- std/neko/_std/sys/ssl/Certificate.hx | 2 +- std/neko/_std/sys/thread/Thread.hx | 201 +- std/php/Boot.hx | 13 +- std/php/Collator.hx | 71 + std/php/Const.hx | 195 ++ std/php/DateInterval.hx | 45 + std/php/DatePeriod.hx | 47 + std/php/DateTime.hx | 65 + std/php/DateTimeImmutable.hx | 65 + std/php/DateTimeInterface.hx | 52 + std/php/DateTimeZone.hx | 54 + std/php/Finfo.hx | 36 + std/php/Global.hx | 380 ++- std/php/Locale.hx | 59 + std/php/LogicException.hx | 69 + std/php/RuntimeException.hx | 39 + std/php/StdClass.hx | 2 +- std/php/Syntax.hx | 15 +- std/php/Syntax.macro.hx | 70 + std/php/Transliterator.hx | 45 + std/php/Web.hx | 2 +- std/php/_polyfills.php | 10 + std/php/_std/EReg.hx | 6 +- std/php/_std/Std.hx | 1 + std/php/_std/StringTools.hx | 5 + std/php/_std/Type.hx | 2 +- std/php/_std/haxe/Exception.hx | 2 +- std/php/_std/haxe/Rest.hx | 50 + std/php/_std/haxe/crypto/Base64.hx | 6 +- std/php/_std/haxe/io/Bytes.hx | 6 +- std/php/_std/haxe/io/BytesData.hx | 4 + std/php/_std/sys/db/Sqlite.hx | 107 +- std/php/db/PDO.hx | 1 + std/php/net/Socket.hx | 4 +- std/python/_std/Std.hx | 1 + std/python/_std/Sys.hx | 18 +- std/python/_std/haxe/Exception.hx | 2 +- std/python/_std/sys/thread/Deque.hx | 83 + std/python/_std/sys/thread/Lock.hx | 42 + .../_std/sys/thread/Mutex.hx} | 39 +- std/python/_std/sys/thread/Thread.hx | 170 ++ std/python/_std/sys/thread/Tls.hx | 30 + std/python/internal/HxOverrides.hx | 2 +- std/python/lib/subprocess/Popen.hx | 2 +- std/python/net/SslSocket.hx | 2 +- std/sys/Http.hx | 2 +- std/sys/db/Mysql.hx | 2 +- std/sys/db/ResultSet.hx | 34 + std/sys/thread/Deque.hx | 4 + std/sys/thread/ElasticThreadPool.hx | 198 ++ std/sys/thread/EventLoop.hx | 245 ++ std/sys/thread/FixedThreadPool.hx | 116 + std/sys/thread/IThreadPool.hx | 51 + std/sys/thread/NoEventLoopException.hx | 9 + std/sys/thread/Thread.hx | 42 +- std/sys/thread/ThreadPoolException.hx | 6 + tests/README.md | 37 +- tests/RunCi.hx | 33 +- tests/benchs/.vscode/settings.json | 2 +- tests/benchs/mandelbrot/compile-jvm.hxml | 6 +- tests/display/src/DisplayTestCase.hx | 3 + tests/display/src/DisplayTestContext.hx | 15 +- tests/display/src/Macro.hx | 1 + tests/display/src/cases/Abstract.hx | 12 +- tests/display/src/cases/ArrowFunctions.hx | 4 +- tests/display/src/cases/DocumentSymbols.hx | 9 + tests/display/src/cases/Issue6405.hx | 2 +- tests/display/src/cases/Issue6421.hx | 2 +- tests/display/src/cases/Issue6442.hx | 2 +- tests/display/src/cases/Issue6756.hx | 2 +- tests/display/src/cases/Issue6779.hx | 2 +- tests/display/src/cases/Issue7022.hx | 2 +- tests/display/src/cases/Issue7023.hx | 6 +- tests/display/src/cases/Issue7047.hx | 2 +- tests/display/src/cases/Issue7057.hx | 2 +- tests/display/src/cases/Issue7061.hx | 6 +- tests/display/src/cases/Issue7102.hx | 2 +- tests/display/src/cases/Issue7248.hx | 2 +- tests/display/src/cases/Issue7753.hx | 59 + tests/display/src/cases/Issue7761.hx | 2 +- tests/display/src/cases/Issue7943.hx | 6 + tests/display/src/cases/Issue8078.hx | 2 +- tests/display/src/cases/Issue8789.hx | 2 +- tests/display/src/cases/Issue9401.hx | 40 + tests/display/src/cases/Issue9554.hx | 26 + tests/display/src/cases/Issue9824.hx | 20 + tests/display/src/cases/Issue9841.hx | 27 + tests/display/src/cases/Override.hx | 12 +- tests/display/src/cases/PropertyAccessors.hx | 2 +- tests/display/src/cases/StaticExtension.hx | 8 +- tests/display/src/cases/Super.hx | 2 +- tests/misc/compile.hxml | 2 +- .../Issue5189/compile-fail.hxml.stderr | 4 +- .../compiler_loops/projects/Issue9397/Main.hx | 12 + .../projects/Issue9397/compile.hxml} | 0 .../projects/Issue9428/TypedefAbstract.hx | 15 + .../projects/Issue9428/TypedefTypedef.hx | 13 + .../projects/Issue9428/typedefAbstract.hxml | 1 + .../projects/Issue9428/typedefTypedef.hxml | 1 + .../Issue3526/IncompatibleCombinations.hx | 8 +- tests/misc/cs/projects/Issue3526/Main.hx | 12 +- ...incompatible-combinations-fail.hxml.stderr | 8 +- tests/misc/cs/projects/Issue7875/Main.hx | 2 +- tests/misc/es6/Test.hx | 16 + .../Issue2689/compile-fail.hxml.stderr | 6 +- .../misc/java/projects/Issue9210/compile.hxml | 3 +- tests/misc/java/projects/Issue9574/Main.hx | 3 + tests/misc/java/projects/Issue9574/Test.java | 3 + .../misc/java/projects/Issue9574/compile.hxml | 10 + .../Main.hx | 15 + .../compile-fail.hxml | 3 + .../compile-fail.hxml.stderr | 4 + .../Main.hx | 22 + .../compile-fail.hxml | 3 + .../compile-fail.hxml.stderr | 3 + .../Main.hx | 22 + .../compile-fail.hxml | 3 + .../compile-fail.hxml.stderr | 3 + .../missing-overload-implementation/Main.hx | 19 + .../compile-fail.hxml | 3 + .../compile-fail.hxml.stderr | 3 + .../missing-overload-implementations/Main.hx | 16 + .../compile-fail.hxml | 3 + .../compile-fail.hxml.stderr | 4 + tests/misc/java/projects/Issue9730/Main.hx | 9 + .../java/projects/Issue9730/compile-fail.hxml | 3 + .../Issue9730/compile-fail.hxml.stderr | 2 + tests/misc/java/projects/Issue9768/Main.hx | 8 + .../misc/java/projects/Issue9768/compile.hxml | 3 + tests/misc/projects/Issue10005/Main.hx | 8 + .../projects/Issue10005/compile-fail.hxml | 1 + .../Issue10005/compile-fail.hxml.stderr | 1 + tests/misc/projects/Issue10024/Main.hx | 21 + .../projects/Issue10024/compile-fail.hxml | 1 + .../Issue10024/compile-fail.hxml.stderr | 2 + tests/misc/projects/Issue10039/Main.hx | 4 + .../projects/Issue10039/compile-fail.hxml | 1 + .../Issue10039/compile-fail.hxml.stderr | 1 + tests/misc/projects/Issue10052/Main.hx | 22 + .../projects/Issue10052/compile-fail.hxml | 1 + .../Issue10052/compile-fail.hxml.stderr | 1 + .../Issue1310/compile1-fail.hxml.stderr | 2 +- .../Issue2148/compile1-fail.hxml.stderr | 2 +- .../Issue2232/compile1-fail.hxml.stderr | 2 +- .../Issue2263/import-completion.hxml.stderr | 2 +- .../subtype-static-completion.hxml.stderr | 2 +- .../Issue2472/compile-fail.hxml.stderr | 6 +- .../Issue2969/compile-fail.hxml.stderr | 8 +- .../Issue3192/compile1-fail.hxml.stderr | 4 +- tests/misc/projects/Issue3238/NonExtern.hx | 4 - .../projects/Issue3238/non-extern-fail.hxml | 1 - .../Issue3238/non-extern-fail.hxml.stderr | 1 - .../projects/Issue3288/with-type.hxml.stderr | 2 +- .../Issue3361/compile1-fail.hxml.stderr | 8 +- .../Issue3361/compile2-fail.hxml.stderr | 8 +- .../Issue3417/compile-fail.hxml.stderr | 4 +- tests/misc/projects/Issue3607/Main.hx | 24 - .../misc/projects/Issue3607/compile-fail.hxml | 1 - .../Issue3607/compile-fail.hxml.stderr | 1 - .../Issue3710/compile-1-fail.hxml.stderr | 2 +- .../Issue3710/compile-2-fail.hxml.stderr | 2 +- .../Issue3781/compile-fail.hxml.stderr | 5 +- tests/misc/projects/Issue3975/Main.hx | 2 +- .../Issue3975/compile-fail.hxml.stderr | 4 +- .../Issue4250/compile-fail.hxml.stderr | 4 +- tests/misc/projects/Issue4364/Main.hx | 2 +- .../Issue4364/compile-fail.hxml.stderr | 4 +- .../Issue4378/compile-fail.hxml.stderr | 8 +- tests/misc/projects/Issue4456/Main.hx | 2 +- .../Issue4540/compile-fail.hxml.stderr | 2 +- .../projects/Issue4651/compile.hxml.stderr | 2 +- tests/misc/projects/Issue4764/Main1.hx | 2 +- .../Issue4764/compile1-fail.hxml.stderr | 2 +- .../Issue4775/compile1-fail.hxml.stderr | 5 +- .../Issue4803/compile-fail.hxml.stderr | 6 +- .../projects/Issue5122/compile.hxml.stderr | 2 +- .../projects/Issue5128/compile.hxml.stderr | 2 +- .../Issue5206/compile-fail.hxml.stderr | 4 +- .../Issue5644/compile-fail.hxml.stderr | 2 +- .../Issue5940/compile-fail.hxml.stderr | 1 + .../Issue5946/compile-fail.hxml.stderr | 12 +- .../Issue5949/compile-fail.hxml.stderr | 3 +- tests/misc/projects/Issue6030/Main1.hx | 2 +- tests/misc/projects/Issue6065/Main.hx | 11 + .../misc/projects/Issue6065/compile-fail.hxml | 3 + .../Issue6065/compile-fail.hxml.stderr | 16 + .../Issue6525/compile-fail.hxml.disabled | 1 + .../Issue6584/compile5-fail.hxml.stderr | 2 +- .../Issue6714/compile-fail.hxml.stderr | 2 +- .../Issue6757/compile-fail.hxml.stderr | 4 +- tests/misc/projects/Issue6790/Main.hx | 1 + .../Issue6790/compile-fail.hxml.stderr | 2 +- .../projects/Issue6790/compile.hxml.stderr | 8 +- .../Issue6796/compile-fail.hxml.stderr | 4 +- tests/misc/projects/Issue6810/Fail.hx | 2 +- tests/misc/projects/Issue6810/Main.hx | 2 +- .../Issue6810/compile-fail.hxml.stderr | 12 +- .../Issue6826/compile-fail.hxml.stderr | 4 +- .../Issue6878/compile-fail.hxml.stderr | 4 +- .../Issue6878/compile1-fail.hxml.stderr | 5 +- .../Issue7039/compile-fail.hxml.stderr | 4 +- .../Issue7227/compile-fail.hxml.stderr | 6 +- .../Issue7526/compile-fail.hxml.stderr | 4 +- .../Issue7614/compile-fail.hxml.stderr | 2 +- .../Issue7655/compile-fail.hxml.stderr | 2 +- ...-fail.hxml => compile2-fail.hxml.disabled} | 0 .../projects/Issue7905/compile.hxml.stderr | 2 +- .../Issue7968/compile-fail.hxml.stderr | 4 +- .../Issue7997/compile-fail.hxml.stderr | 4 +- tests/misc/projects/Issue8176/Main.hx | 19 + tests/misc/projects/Issue8176/compile.hxml | 5 + .../Issue8283/compile-fail.hxml.stderr | 2 +- .../Issue8488/compile-fail.hxml.stderr | 2 +- .../Issue8517/compile-fail.hxml.stderr | 2 +- .../misc/projects/Issue8618/NoClosureClass.hx | 2 +- .../Issue8618/compile-fail.hxml.stderr | 4 +- .../Issue8618/compile2-fail.hxml.stderr | 4 +- .../Issue8618/compile3-fail.hxml.stderr | 4 +- .../Issue8618/compile4-fail.hxml.stderr | 4 +- .../Issue8704/compile-fail.hxml.stderr | 2 +- tests/misc/projects/Issue8787/Main1.hx | 9 + tests/misc/projects/Issue8787/Main2.hx | 9 + .../projects/Issue8787/compile1-fail.hxml | 2 + .../Issue8787/compile1-fail.hxml.stderr | 3 + .../projects/Issue8787/compile2-fail.hxml | 2 + .../Issue8787/compile2-fail.hxml.stderr | 3 + .../Issue8819/compile-fail.hxml.stderr | 2 +- .../InterfaceFields-fail.hxml.stderr | 2 +- .../Issue9010/NativeMeta-fail.hxml.stderr | 6 +- tests/misc/projects/Issue9015/Main.hx | 13 + .../misc/projects/Issue9015/compile-fail.hxml | 1 + .../Issue9015/compile-fail.hxml.stderr | 1 + .../Issue9017/compile-fail.hxml.stderr | 2 +- tests/misc/projects/Issue9417/Main.hx | 14 + .../misc/projects/Issue9417/compile-fail.hxml | 1 + .../Issue9417/compile-fail.hxml.stderr | 1 + tests/misc/projects/Issue9425/Main.hx | 12 + .../projects/Issue9425/compile-success.hxml | 1 + .../Issue9425/compile-success.hxml.stderr | 1 + tests/misc/projects/Issue9514/Main.hx | 8 + tests/misc/projects/Issue9514/compile.hxml | 3 + .../projects/Issue9514/compile.hxml.stderr | 1 + tests/misc/projects/Issue9556/Main.hx | 8 + .../misc/projects/Issue9556/compile-fail.hxml | 1 + .../Issue9556/compile-fail.hxml.stderr | 3 + tests/misc/projects/Issue9612/Main.hx | 7 + .../misc/projects/Issue9612/compile-fail.hxml | 1 + .../Issue9612/compile-fail.hxml.stderr | 1 + .../Issue9619/abstract-dynamic/Main.hx | 9 + .../abstract-dynamic/compile-fail.hxml | 2 + .../abstract-dynamic/compile-fail.hxml.stderr | 1 + .../abstract-expression-inline/Main.hx | 10 + .../compile-fail.hxml | 2 + .../compile-fail.hxml.stderr | 1 + .../Issue9619/abstract-final-class/Main.hx | 9 + .../abstract-final-class/compile-fail.hxml | 2 + .../compile-fail.hxml.stderr | 1 + .../projects/Issue9619/abstract-final/Main.hx | 9 + .../abstract-final/compile-fail.hxml | 2 + .../abstract-final/compile-fail.hxml.stderr | 1 + .../Issue9619/abstract-inline/Main.hx | 10 + .../abstract-inline/compile-fail.hxml | 2 + .../abstract-inline/compile-fail.hxml.stderr | 1 + .../Issue9619/abstract-interface/Main.hx | 7 + .../abstract-interface/compile-fail.hxml | 2 + .../compile-fail.hxml.stderr | 1 + .../Issue9619/abstract-static/Main.hx | 9 + .../abstract-static/compile-fail.hxml | 2 + .../abstract-static/compile-fail.hxml.stderr | 1 + .../Issue9619/abstract-structInit/Main.hx | 9 + .../abstract-structInit/compile-fail.hxml | 2 + .../compile-fail.hxml.stderr | 2 + .../abstract-with-expression/Main.hx | 9 + .../compile-fail.hxml | 2 + .../compile-fail.hxml.stderr | 1 + .../Issue9619/constructing-abstract/Main.hx | 12 + .../constructing-abstract/compile-fail.hxml | 2 + .../compile-fail.hxml.stderr | 1 + .../missing-abstract-on-class/Main.hx | 7 + .../compile-fail.hxml | 2 + .../compile-fail.hxml.stderr | 2 + .../Issue9619/missing-implementation/Main.hx | 10 + .../missing-implementation/compile-fail.hxml | 2 + .../compile-fail.hxml.stderr | 3 + .../projects/Issue9619/super-abstract/Main.hx | 13 + .../super-abstract/compile-fail.hxml | 2 + .../super-abstract/compile-fail.hxml.stderr | 1 + tests/misc/projects/Issue9631/Fields.hx | 7 + tests/misc/projects/Issue9631/Types.hx | 9 + .../Issue9631/compile-fields-fail.hxml | 1 + .../Issue9631/compile-fields-fail.hxml.stderr | 1 + .../Issue9631/compile-types-fail.hxml | 1 + .../Issue9631/compile-types-fail.hxml.stderr | 2 + tests/misc/projects/Issue9640/Main.hx | 21 + .../misc/projects/Issue9640/compile-fail.hxml | 1 + .../Issue9640/compile-fail.hxml.stderr | 3 + tests/misc/projects/Issue9659/Main.hx | 8 +- .../Issue9659/compile-fail.hxml.stderr | 4 +- tests/misc/projects/Issue9692/Main.hx | 4 + .../misc/projects/Issue9692/compile-fail.hxml | 1 + .../Issue9692/compile-fail.hxml.stderr | 1 + tests/misc/projects/Issue9712/Main.hx | 8 + tests/misc/projects/Issue9712/compile.hxml | 2 + tests/misc/projects/Issue9769/Main.hx | 32 + tests/misc/projects/Issue9769/compile.hxml | 1 + tests/misc/projects/Issue9785/Main.hx | 5 + .../misc/projects/Issue9785/compile-fail.hxml | 1 + .../Issue9785/compile-fail.hxml.stderr | 1 + tests/misc/projects/Issue9796/Main.hx | 12 + .../misc/projects/Issue9796/compile-fail.hxml | 1 + .../Issue9796/compile-fail.hxml.stderr | 1 + tests/misc/projects/Issue9811/Main.hx | 5 + tests/misc/projects/Issue9811/Stream.hx | 44 + tests/misc/projects/Issue9811/compile.hxml | 1 + .../Issue9971/compile-fail.hxml.stderr | 2 +- .../extern-overloads/ambiguous-static/Main.hx | 4 + .../ambiguous-static/compile-fail.hxml | 2 + .../ambiguous-static/compile-fail.hxml.stderr | 2 + .../amgiuous-call-site/Main.hx | 12 + .../amgiuous-call-site/compile-fail.hxml | 2 + .../compile-fail.hxml.stderr | 3 + .../extern-overloads/missing-override/Main.hx | 7 + .../compile-fail.hxml.disabled | 2 + .../missing-override/compile-fail.hxml.stderr | 1 + .../extern-overloads/not-not-extern/Main.hx | 3 + .../not-not-extern/compile-fail.hxml | 2 + .../not-not-extern/compile-fail.hxml.stderr | 1 + .../not-on-constructor/Main.hx | 3 + .../not-on-constructor/compile-fail.hxml | 2 + .../compile-fail.hxml.stderr | 1 + .../projects/inline-constructors/Extern.hx | 11 + .../inline-constructors/ForceInline.hx | 11 + .../compile-extern-fail.hxml | 2 + .../compile-extern-fail.hxml.stderr | 2 + .../compile-force-inline-fail.hxml | 2 + .../compile-force-inline-fail.hxml.stderr | 2 + .../issue5002/compile-fail.hxml.stderr | 4 +- .../issue5002/compile2-fail.hxml.stderr | 14 +- tests/misc/python/projects/Issue9637/Main.hx | 6 + .../misc/python/projects/Issue9637/build.hxml | 4 + tests/misc/python/projects/Issue9666/Main.hx | 9 + .../misc/python/projects/Issue9666/build.hxml | 3 + .../resolution/projects/Issue9367/Main.hx | 6 +- .../projects/Issue9367/pack/Mod3.hx | 11 + .../projects/Issue9367/pack/UsageImport.hx | 7 +- .../projects/Issue9367/pack/UsageNoImport.hx | 6 +- .../projects/modulestatics/Duplicate.hx | 2 + .../projects/modulestatics/Macro.hx | 58 + .../resolution/projects/modulestatics/Main.hx | 105 + .../projects/modulestatics/ModWithPrivate.hx | 7 + .../ModWithStaticAndClassStatic.hx | 17 + .../ModWithStaticAndClassStatic2.hx | 17 + .../ModuleStaticWithNoMainClass.hx | 5 + .../ModuleStaticWithNoMainClassInPack.hx | 5 + .../projects/modulestatics/PrivateAccess.hx | 5 + .../projects/modulestatics/PrivateImport.hx | 7 + .../projects/modulestatics/RootMod1.hx | 7 + .../projects/modulestatics/RootMod2.hx | 7 + .../projects/modulestatics/RootMod3.hx | 7 + .../projects/modulestatics/RootMod4.hx | 7 + .../projects/modulestatics/Wildcard.hx | 13 + .../modulestatics/compile-duplicate-fail.hxml | 2 + .../compile-duplicate-fail.hxml.stderr | 2 + ...pile-moduleStaticWithNoMainClass-fail.hxml | 2 + ...duleStaticWithNoMainClass-fail.hxml.stderr | 1 + ...oduleStaticWithNoMainClassInPack-fail.hxml | 2 + ...aticWithNoMainClassInPack-fail.hxml.stderr | 1 + .../modulestatics/compile-private-fail.hxml | 2 + .../compile-private-fail.hxml.stderr | 1 + .../modulestatics/compile-private2-fail.hxml | 2 + .../compile-private2-fail.hxml.stderr | 1 + .../projects/modulestatics/compile.hxml | 8 + .../projects/modulestatics/pack/InnerMod.hx | 11 + .../projects/modulestatics/pack/Mod1.hx | 9 + .../projects/modulestatics/pack/Mod2.hx | 11 + .../modulestatics/pack/inner/InnerMod.hx | 9 + .../projects/modulestatics/pack/inner/Test.hx | 31 + .../modulestatics/pack/shadow/Test.hx | 9 + .../projects/spec/ModWithPrivate.hx | 1 + .../resolution/projects/spec/PrivateImport.hx | 7 + .../projects/spec/compile-private-fail.hxml | 2 + .../spec/compile-private-fail.hxml.stderr | 2 + tests/nullsafety/src/cases/TestStrict.hx | 23 +- tests/optimization/run.hxml | 1 + .../src/TestInlineConstructors.hx | 133 + tests/optimization/src/issues/Issue5436.hx | 4 +- tests/optimization/src/issues/Issue6715.hx | 10 +- tests/optimization/src/issues/Issue9778.hx | 166 ++ tests/runci/Config.hx | 17 +- tests/runci/Deployment.hx | 45 +- tests/runci/targets/Cpp.hx | 37 +- tests/runci/targets/Cs.hx | 27 +- tests/runci/targets/Flash.hx | 14 +- tests/runci/targets/Hl.hx | 20 +- tests/runci/targets/Java.hx | 4 +- tests/runci/targets/Js.hx | 35 +- tests/runci/targets/Jvm.hx | 19 +- tests/runci/targets/Lua.hx | 2 +- tests/runci/targets/Macro.hx | 4 +- tests/runci/targets/Neko.hx | 6 +- tests/runci/targets/Php.hx | 42 +- tests/runci/targets/Python.hx | 6 + tests/server/build.hxml | 7 +- tests/server/src/TestCase.hx | 36 +- tests/server/src/cases/ReplaceRanges.hx | 1 - tests/server/src/cases/ServerTests.hx | 12 +- tests/server/src/cases/display/InheritDoc.hx | 39 + .../src/cases/display/issues/Issue10008.hx | 22 + .../src/cases/display/issues/Issue8073.hx | 29 + .../src/cases/display/issues/Issue8805.hx | 2 +- .../src/cases/display/issues/Issue9039.hx | 3 +- .../src/cases/display/issues/Issue9087.hx | 46 +- .../src/cases/display/issues/Issue9183.hx | 20 + .../src/cases/display/issues/Issue9266.hx | 18 + .../src/cases/display/issues/Issue9383.hx | 20 + .../src/cases/display/issues/Issue9446.hx | 16 + .../src/cases/display/issues/Issue9449.hx | 6 +- .../src/cases/display/issues/Issue9463.hx | 19 + .../src/cases/display/issues/Issue9790.hx | 28 + .../src/cases/display/issues/Issue9824.hx | 28 + .../src/cases/display/issues/Issue9956.hx | 28 + tests/server/src/utils/macro/DebugFailures.hx | 26 + .../utils/macro/DisplayTestBuilder.macro.hx | 3 +- .../src/utils/macro/TestBuilder.macro.hx | 54 +- .../server/test/templates/InheritDocTypes.hx | 28 + tests/server/test/templates/Issue9918.hx | 48 + tests/server/test/templates/Issue9956Types.hx | 15 + .../test/templates/issues/Issue9087/A.hx | 13 - .../test/templates/issues/Issue9449/Macro.hx | 58 +- tests/sys/compile-jvm.hxml | 8 +- tests/sys/genTestRes.py | 1 - tests/sys/src/ExitCode.hx | 8 +- tests/sys/src/Main.hx | 9 + tests/sys/src/TestArguments.hx | 8 +- tests/sys/src/TestSys.hx | 2 + tests/sys/src/TestUnicode.hx | 10 +- tests/sys/src/UtilityProcess.hx | 4 +- tests/sys/src/db/SqliteSetup.hx | 27 + tests/sys/src/db/TestSqliteConnection.hx | 60 + tests/sys/src/db/TestSqliteResultSet.hx | 62 + tests/threads-old/build.hxml | 4 + tests/{threads => threads-old}/res/tree1.txt | 0 tests/threads-old/src/Main.hx | 15 + .../src/cases/DequeBrackets.hx | 0 .../src/cases/Issue3767.hx | 9 +- .../src/cases/Issue4878.hx | 10 +- .../src/cases/Issue8063.hx | 8 +- .../src/cases/Issue9863.hx | 0 .../src/cases/TestThreads.hx | 8 +- .../src/cases/WeirdTreeSum.hx | 8 +- tests/threads-old/src/import.hx | 5 + tests/threads/build.hxml | 9 +- tests/threads/src/Main.hx | 22 +- .../src/cases/TestElasticThreadPool.hx | 32 + tests/threads/src/cases/TestEvents.hx | 104 + .../threads/src/cases/TestFixedThreadPool.hx | 10 + tests/threads/src/cases/TestMainLoop.hx | 22 + tests/threads/src/cases/TestTimer.hx | 94 + tests/threads/src/import.hx | 7 +- tests/threads/src/misc/TestThreadPoolBase.hx | 104 + tests/unit/.vscode/settings.json | 19 + tests/unit/compile-cppia-host.hxml | 1 + tests/unit/compile-cs-travis.hxml | 7 - tests/unit/compile-cs-unsafe-travis.hxml | 7 - tests/unit/compile-each.hxml | 2 +- tests/unit/compile-jvm-only.hxml | 5 + tests/unit/compile-jvm.hxml | 5 +- tests/unit/compile-remoting.hxml | 3 - tests/unit/compile.hxml | 3 - tests/unit/native_cs/hxcs_build.txt | 2 + .../src/haxe/test/AttrWithNullType.cs | 17 + tests/unit/src/RunSauceLabs.hx | 15 +- tests/unit/src/unit/MyAbstract.hx | 2 +- tests/unit/src/unit/RemotingServer.hx | 39 - tests/unit/src/unit/Test.hx | 4 +- tests/unit/src/unit/TestArrowFunctions.hx | 8 +- tests/unit/src/unit/TestCSharp.hx | 4 +- .../src/unit/TestConstrainedMonomorphs.hx | 124 + tests/unit/src/unit/TestExceptions.hx | 27 +- tests/unit/src/unit/TestHttp.hx | 6 +- tests/unit/src/unit/TestIO.hx | 2 +- tests/unit/src/unit/TestMacro.hx | 1 + tests/unit/src/unit/TestMain.hx | 267 +- tests/unit/src/unit/TestMatch.hx | 1 + tests/unit/src/unit/TestMisc.hx | 7 + tests/unit/src/unit/TestModuleStatics.hx | 109 + tests/unit/src/unit/TestModuleStaticsMacro.hx | 41 + tests/unit/src/unit/TestOverloads.hx | 132 +- .../unit/src/unit/TestOverloadsForEveryone.hx | 47 + tests/unit/src/unit/TestPhp.hx | 18 +- tests/unit/src/unit/TestRemoting.hx | 177 -- tests/unit/src/unit/TestRest.hx | 170 ++ tests/unit/src/unit/TestSyntaxModule.hx | 10 +- tests/unit/src/unit/TestType.hx | 4 +- tests/unit/src/unit/UnitBuilder.hx | 6 +- .../unit/src/unit/hxcpp_issues/Issue10100.hx | 24 + tests/unit/src/unit/issues/Issue10007.hx | 19 + tests/unit/src/unit/issues/Issue10012.hx | 19 + tests/unit/src/unit/issues/Issue10018.hx | 12 + tests/unit/src/unit/issues/Issue10030.hx | 16 + tests/unit/src/unit/issues/Issue10041.hx | 8 + tests/unit/src/unit/issues/Issue10052.hx | 31 + tests/unit/src/unit/issues/Issue10057.hx | 13 + tests/unit/src/unit/issues/Issue10073.hx | 41 + tests/unit/src/unit/issues/Issue10083.hx | 26 + tests/unit/src/unit/issues/Issue10098.hx | 14 + tests/unit/src/unit/issues/Issue1284.hx | 24 + tests/unit/src/unit/issues/Issue2184.hx | 2 +- tests/unit/src/unit/issues/Issue2584.hx | 1 + tests/unit/src/unit/issues/Issue2614.hx | 2 +- tests/unit/src/unit/issues/Issue2622.hx | 2 +- .../src/unit/issues/Issue2668.hx.disabled | 2 +- tests/unit/src/unit/issues/Issue2688.hx | 2 +- tests/unit/src/unit/issues/Issue2713.hx | 2 +- .../src/unit/issues/Issue2857.hx.disabled | 8 +- .../src/{unitstd => unit/issues}/Issue3067.hx | 2 +- tests/unit/src/unit/issues/Issue3192.hx | 2 +- tests/unit/src/unit/issues/Issue3297.hx | 9 + tests/unit/src/unit/issues/Issue3303.hx | 2 +- tests/unit/src/unit/issues/Issue3345.hx | 16 +- tests/unit/src/unit/issues/Issue3388.hx | 30 - tests/unit/src/unit/issues/Issue3494.hx | 2 +- tests/unit/src/unit/issues/Issue3513.hx | 4 +- tests/unit/src/unit/issues/Issue3531.hx | 7 - tests/unit/src/unit/issues/Issue3578.hx | 4 +- tests/unit/src/unit/issues/Issue3607.hx | 28 + tests/unit/src/unit/issues/Issue3777.hx | 2 +- tests/unit/src/unit/issues/Issue3967.hx | 2 +- tests/unit/src/unit/issues/Issue4327.hx | 2 +- tests/unit/src/unit/issues/Issue4457.hx | 2 +- tests/unit/src/unit/issues/Issue4798.hx | 2 +- tests/unit/src/unit/issues/Issue4986.hx | 4 - tests/unit/src/unit/issues/Issue5027.hx | 2 +- tests/unit/src/unit/issues/Issue5108.hx | 4 +- tests/unit/src/unit/issues/Issue5207.hx | 8 + tests/unit/src/unit/issues/Issue5385.hx | 3 +- tests/unit/src/unit/issues/Issue5470.hx | 2 +- tests/unit/src/unit/issues/Issue6036.hx | 2 +- tests/unit/src/unit/issues/Issue6121.hx | 4 +- tests/unit/src/unit/issues/Issue6375.hx | 2 +- tests/unit/src/unit/issues/Issue6379.hx | 2 + tests/unit/src/unit/issues/Issue7428.hx | 2 +- tests/unit/src/unit/issues/Issue7599.hx | 64 + tests/unit/src/unit/issues/Issue7656.hx | 20 + tests/unit/src/unit/issues/Issue7942.hx | 10 + tests/unit/src/unit/issues/Issue8145.hx | 15 + tests/unit/src/unit/issues/Issue8427.hx | 16 + tests/unit/src/unit/issues/Issue8435.hx | 2 +- tests/unit/src/unit/issues/Issue8760.hx | 26 + tests/unit/src/unit/issues/Issue8869.hx | 2 +- tests/unit/src/unit/issues/Issue8966.hx | 22 + tests/unit/src/unit/issues/Issue8984.hx | 11 + tests/unit/src/unit/issues/Issue9123.hx | 20 + tests/unit/src/unit/issues/Issue9144.hx | 10 + tests/unit/src/unit/issues/Issue9309.hx | 9 + tests/unit/src/unit/issues/Issue9366.hx | 2 +- tests/unit/src/unit/issues/Issue9370.hx | 9 + tests/unit/src/unit/issues/Issue9372.hx | 10 + tests/unit/src/unit/issues/Issue9403.hx | 12 + tests/unit/src/unit/issues/Issue9405.hx | 10 + tests/unit/src/unit/issues/Issue9438.hx | 10 + tests/unit/src/unit/issues/Issue9491.hx | 14 + tests/unit/src/unit/issues/Issue9498.hx | 24 + tests/unit/src/unit/issues/Issue9516.hx | 81 + tests/unit/src/unit/issues/Issue9542.hx | 18 + tests/unit/src/unit/issues/Issue9548.hx | 24 + tests/unit/src/unit/issues/Issue9554.hx | 17 + tests/unit/src/unit/issues/Issue9560.hx | 14 + tests/unit/src/unit/issues/Issue9565.hx | 11 + tests/unit/src/unit/issues/Issue9576.hx | 13 + tests/unit/src/unit/issues/Issue9577.hx | 29 + tests/unit/src/unit/issues/Issue9579.hx | 21 + tests/unit/src/unit/issues/Issue9590.hx | 25 + tests/unit/src/unit/issues/Issue9593.hx | 19 + tests/unit/src/unit/issues/Issue9594.hx | 15 + tests/unit/src/unit/issues/Issue9597.hx | 21 + tests/unit/src/unit/issues/Issue9601.hx | 16 + tests/unit/src/unit/issues/Issue9603.hx | 17 + tests/unit/src/unit/issues/Issue9619.hx | 101 + tests/unit/src/unit/issues/Issue9627.hx | 23 + tests/unit/src/unit/issues/Issue9652.hx | 11 + tests/unit/src/unit/issues/Issue9661.hx | 15 + tests/unit/src/unit/issues/Issue9667.hx | 28 + tests/unit/src/unit/issues/Issue9680.hx | 53 + tests/unit/src/unit/issues/Issue9681.hx | 25 + tests/unit/src/unit/issues/Issue9688.hx | 18 + tests/unit/src/unit/issues/Issue9710.hx | 11 + tests/unit/src/unit/issues/Issue9715.hx | 11 + tests/unit/src/unit/issues/Issue9719.hx | 30 + tests/unit/src/unit/issues/Issue9721.hx | 57 + tests/unit/src/unit/issues/Issue9735.hx | 26 + tests/unit/src/unit/issues/Issue9736.hx | 12 + tests/unit/src/unit/issues/Issue9737.hx | 20 + tests/unit/src/unit/issues/Issue9741.hx | 36 + tests/unit/src/unit/issues/Issue9744.hx | 111 + tests/unit/src/unit/issues/Issue9745.hx | 14 + tests/unit/src/unit/issues/Issue9746.hx | 222 ++ tests/unit/src/unit/issues/Issue9749.hx | 45 + tests/unit/src/unit/issues/Issue9755.hx | 19 + tests/unit/src/unit/issues/Issue9757.hx | 14 + tests/unit/src/unit/issues/Issue9758.hx | 55 + tests/unit/src/unit/issues/Issue9759.hx | 8 + tests/unit/src/unit/issues/Issue9761.hx | 38 + tests/unit/src/unit/issues/Issue9764.hx | 22 + tests/unit/src/unit/issues/Issue9770.hx | 112 + tests/unit/src/unit/issues/Issue9771.hx | 39 + tests/unit/src/unit/issues/Issue9777.hx | 11 + tests/unit/src/unit/issues/Issue9784.hx | 21 + tests/unit/src/unit/issues/Issue9791.hx | 22 + tests/unit/src/unit/issues/Issue9795.hx | 17 + tests/unit/src/unit/issues/Issue9797.hx | 15 + tests/unit/src/unit/issues/Issue9806.hx | 15 + tests/unit/src/unit/issues/Issue9807.hx | 49 + tests/unit/src/unit/issues/Issue9812.hx | 21 + tests/unit/src/unit/issues/Issue9828.hx | 28 + tests/unit/src/unit/issues/Issue9836.hx | 44 + tests/unit/src/unit/issues/Issue9854.hx | 20 + tests/unit/src/unit/issues/Issue9874.hx | 16 + tests/unit/src/unit/issues/Issue9883.hx | 24 + tests/unit/src/unit/issues/Issue9894.hx | 9 + tests/unit/src/unit/issues/Issue9899.hx | 10 + tests/unit/src/unit/issues/Issue9904.hx | 7 + tests/unit/src/unit/issues/Issue9905.hx | 42 + tests/unit/src/unit/issues/Issue9938.hx | 13 + tests/unit/src/unit/issues/Issue9946.hx | 30 + .../src/unit/issues/misc/Issue2003Macro.hx | 2 +- .../src/unit/issues/misc/Issue5207Macro.hx | 34 + .../src/unit/issues/misc/Issue9661Macro.hx | 27 + tests/unit/src/unitstd/Array.unit.hx | 6 +- tests/unit/src/unitstd/Date.unit.hx | 8 +- .../{IntIterator.hx => IntIterator.unit.hx} | 4 +- .../{Http.unit2.hx => Http.unit.hx.disabled} | 0 ...yBufferView.hx => ArrayBufferView.unit.hx} | 0 1034 files changed, 31386 insertions(+), 9889 deletions(-) create mode 100644 .github/workflows/main.yml delete mode 100644 azure-pipelines.yml delete mode 100644 extra/azure-pipelines/build-linux.yml delete mode 100644 extra/azure-pipelines/build-mac.yml delete mode 100644 extra/azure-pipelines/build-windows.yml delete mode 100644 extra/azure-pipelines/install-neko-snapshot.yaml delete mode 100644 extra/azure-pipelines/test-windows.yml create mode 100644 extra/github-actions/Main.hx create mode 100644 extra/github-actions/build-linux.yml create mode 100644 extra/github-actions/build-mac.yml create mode 100644 extra/github-actions/build-windows.yml create mode 100644 extra/github-actions/build.hxml create mode 100644 extra/github-actions/install-neko.yml create mode 100644 extra/github-actions/test-linux.yml create mode 100644 extra/github-actions/test-mac.yml create mode 100644 extra/github-actions/test-windows.yml create mode 100644 extra/github-actions/workflows/main.yml delete mode 100644 libs/README.md create mode 100644 libs/extlib-leftovers/base64.ml create mode 100644 libs/extlib-leftovers/base64.mli create mode 100644 src/codegen/javaModern.ml delete mode 100644 src/context/display/diagnosticsTypes.ml create mode 100644 src/core/display/javadoc.ml create mode 100644 src/core/inheritDoc.ml delete mode 100644 src/generators/jvm/jvmDebug.ml create mode 100644 src/macro/eval/EvalStackTrace.ml create mode 100644 src/macro/eval/evalIntegers.ml create mode 100644 src/macro/eval/evalLuv.ml create mode 100644 src/typing/callUnification.ml create mode 100644 src/typing/fieldAccess.ml create mode 100644 src/typing/functionArguments.ml create mode 100644 src/typing/operators.ml create mode 100644 src/typing/overloadResolution.ml create mode 100644 std/cpp/Rest.hx create mode 100644 std/cs/Syntax.hx create mode 100644 std/cs/_std/haxe/Rest.hx create mode 100644 std/cs/_std/sys/net/UdpSocket.hx create mode 100644 std/eval/NativeString.hx create mode 100644 std/eval/_std/sys/thread/EventLoop.hx create mode 100644 std/eval/integers/Int64.hx create mode 100644 std/eval/integers/UInt64.hx create mode 100644 std/eval/luv/Async.hx create mode 100644 std/eval/luv/Barrier.hx create mode 100644 std/eval/luv/Buffer.hx create mode 100644 std/eval/luv/Check.hx create mode 100644 std/eval/luv/Condition.hx create mode 100644 std/eval/luv/ConnectedUdp.hx create mode 100644 std/eval/luv/Dir.hx create mode 100644 std/eval/luv/Dns.hx create mode 100644 std/eval/luv/Env.hx create mode 100644 std/eval/luv/File.hx create mode 100644 std/eval/luv/FsEvent.hx create mode 100644 std/eval/luv/FsPoll.hx create mode 100644 std/eval/luv/Handle.hx create mode 100644 std/eval/luv/Idle.hx create mode 100644 std/eval/luv/Loop.hx create mode 100644 std/eval/luv/LuvException.hx create mode 100644 std/eval/luv/Metrics.hx create mode 100644 std/eval/luv/Mutex.hx create mode 100644 std/eval/luv/Network.hx create mode 100644 std/eval/luv/Once.hx create mode 100644 std/eval/luv/OsFd.hx create mode 100644 std/eval/luv/OsSocket.hx create mode 100644 std/eval/luv/Passwd.hx create mode 100644 std/eval/luv/Path.hx create mode 100644 std/eval/luv/Pid.hx create mode 100644 std/eval/luv/Pipe.hx create mode 100644 std/eval/luv/Prepare.hx create mode 100644 std/eval/luv/Process.hx create mode 100644 std/eval/luv/Random.hx create mode 100644 std/eval/luv/Request.hx create mode 100644 std/eval/luv/Resource.hx create mode 100644 std/eval/luv/Result.hx create mode 100644 std/eval/luv/RwLock.hx create mode 100644 std/eval/luv/Semaphore.hx create mode 100644 std/eval/luv/Signal.hx create mode 100644 std/eval/luv/SockAddr.hx create mode 100644 std/eval/luv/Stream.hx create mode 100644 std/eval/luv/SystemInfo.hx create mode 100644 std/eval/luv/Tcp.hx create mode 100644 std/eval/luv/Thread.hx create mode 100644 std/eval/luv/ThreadPool.hx create mode 100644 std/eval/luv/Time.hx create mode 100644 std/eval/luv/Timer.hx create mode 100644 std/eval/luv/Tty.hx create mode 100644 std/eval/luv/UVError.hx create mode 100644 std/eval/luv/Udp.hx create mode 100644 std/eval/luv/Version.hx create mode 100644 std/haxe/Rest.hx create mode 100644 std/haxe/exceptions/ArgumentException.hx create mode 100644 std/haxe/exceptions/NotImplementedException.hx create mode 100644 std/haxe/exceptions/PosException.hx create mode 100644 std/haxe/iterators/RestIterator.hx create mode 100644 std/haxe/iterators/RestKeyValueIterator.hx create mode 100644 std/java/_std/haxe/Rest.hx create mode 100644 std/jvm/CompiledPattern.hx create mode 100644 std/jvm/_std/EReg.hx delete mode 100644 std/jvm/_std/sys/thread/Thread.hx create mode 100644 std/lua/_std/haxe/Rest.hx create mode 100644 std/lua/_std/haxe/format/JsonParser.hx create mode 100644 std/lua/lib/hxluasimdjson/Json.hx create mode 100644 std/php/Collator.hx create mode 100644 std/php/DateInterval.hx create mode 100644 std/php/DatePeriod.hx create mode 100644 std/php/DateTime.hx create mode 100644 std/php/DateTimeImmutable.hx create mode 100644 std/php/DateTimeInterface.hx create mode 100644 std/php/DateTimeZone.hx create mode 100644 std/php/Finfo.hx create mode 100644 std/php/Locale.hx create mode 100644 std/php/LogicException.hx create mode 100644 std/php/Syntax.macro.hx create mode 100644 std/php/Transliterator.hx create mode 100644 std/php/_std/haxe/Rest.hx create mode 100644 std/python/_std/sys/thread/Deque.hx create mode 100644 std/python/_std/sys/thread/Lock.hx rename std/{haxe/xml/Proxy.hx => python/_std/sys/thread/Mutex.hx} (63%) create mode 100644 std/python/_std/sys/thread/Thread.hx create mode 100644 std/python/_std/sys/thread/Tls.hx create mode 100644 std/sys/thread/ElasticThreadPool.hx create mode 100644 std/sys/thread/EventLoop.hx create mode 100644 std/sys/thread/FixedThreadPool.hx create mode 100644 std/sys/thread/IThreadPool.hx create mode 100644 std/sys/thread/NoEventLoopException.hx create mode 100644 std/sys/thread/ThreadPoolException.hx create mode 100644 tests/display/src/cases/Issue7753.hx create mode 100644 tests/display/src/cases/Issue9401.hx create mode 100644 tests/display/src/cases/Issue9554.hx create mode 100644 tests/display/src/cases/Issue9824.hx create mode 100644 tests/display/src/cases/Issue9841.hx create mode 100644 tests/misc/compiler_loops/projects/Issue9397/Main.hx rename tests/misc/{projects/Issue6525/compile-fail.hxml => compiler_loops/projects/Issue9397/compile.hxml} (100%) create mode 100644 tests/misc/compiler_loops/projects/Issue9428/TypedefAbstract.hx create mode 100644 tests/misc/compiler_loops/projects/Issue9428/TypedefTypedef.hx create mode 100644 tests/misc/compiler_loops/projects/Issue9428/typedefAbstract.hxml create mode 100644 tests/misc/compiler_loops/projects/Issue9428/typedefTypedef.hxml create mode 100644 tests/misc/java/projects/Issue9574/Main.hx create mode 100644 tests/misc/java/projects/Issue9574/Test.java create mode 100644 tests/misc/java/projects/Issue9574/compile.hxml create mode 100644 tests/misc/java/projects/Issue9619/missing-overload-implementation-from-interface/Main.hx create mode 100644 tests/misc/java/projects/Issue9619/missing-overload-implementation-from-interface/compile-fail.hxml create mode 100644 tests/misc/java/projects/Issue9619/missing-overload-implementation-from-interface/compile-fail.hxml.stderr create mode 100644 tests/misc/java/projects/Issue9619/missing-overload-implementation-from-parent-2/Main.hx create mode 100644 tests/misc/java/projects/Issue9619/missing-overload-implementation-from-parent-2/compile-fail.hxml create mode 100644 tests/misc/java/projects/Issue9619/missing-overload-implementation-from-parent-2/compile-fail.hxml.stderr create mode 100644 tests/misc/java/projects/Issue9619/missing-overload-implementation-from-parent/Main.hx create mode 100644 tests/misc/java/projects/Issue9619/missing-overload-implementation-from-parent/compile-fail.hxml create mode 100644 tests/misc/java/projects/Issue9619/missing-overload-implementation-from-parent/compile-fail.hxml.stderr create mode 100644 tests/misc/java/projects/Issue9619/missing-overload-implementation/Main.hx create mode 100644 tests/misc/java/projects/Issue9619/missing-overload-implementation/compile-fail.hxml create mode 100644 tests/misc/java/projects/Issue9619/missing-overload-implementation/compile-fail.hxml.stderr create mode 100644 tests/misc/java/projects/Issue9619/missing-overload-implementations/Main.hx create mode 100644 tests/misc/java/projects/Issue9619/missing-overload-implementations/compile-fail.hxml create mode 100644 tests/misc/java/projects/Issue9619/missing-overload-implementations/compile-fail.hxml.stderr create mode 100644 tests/misc/java/projects/Issue9730/Main.hx create mode 100644 tests/misc/java/projects/Issue9730/compile-fail.hxml create mode 100644 tests/misc/java/projects/Issue9730/compile-fail.hxml.stderr create mode 100644 tests/misc/java/projects/Issue9768/Main.hx create mode 100644 tests/misc/java/projects/Issue9768/compile.hxml create mode 100644 tests/misc/projects/Issue10005/Main.hx create mode 100644 tests/misc/projects/Issue10005/compile-fail.hxml create mode 100644 tests/misc/projects/Issue10005/compile-fail.hxml.stderr create mode 100644 tests/misc/projects/Issue10024/Main.hx create mode 100644 tests/misc/projects/Issue10024/compile-fail.hxml create mode 100644 tests/misc/projects/Issue10024/compile-fail.hxml.stderr create mode 100644 tests/misc/projects/Issue10039/Main.hx create mode 100644 tests/misc/projects/Issue10039/compile-fail.hxml create mode 100644 tests/misc/projects/Issue10039/compile-fail.hxml.stderr create mode 100644 tests/misc/projects/Issue10052/Main.hx create mode 100644 tests/misc/projects/Issue10052/compile-fail.hxml create mode 100644 tests/misc/projects/Issue10052/compile-fail.hxml.stderr delete mode 100644 tests/misc/projects/Issue3238/NonExtern.hx delete mode 100644 tests/misc/projects/Issue3238/non-extern-fail.hxml delete mode 100644 tests/misc/projects/Issue3238/non-extern-fail.hxml.stderr delete mode 100644 tests/misc/projects/Issue3607/Main.hx delete mode 100644 tests/misc/projects/Issue3607/compile-fail.hxml delete mode 100644 tests/misc/projects/Issue3607/compile-fail.hxml.stderr create mode 100644 tests/misc/projects/Issue6065/Main.hx create mode 100644 tests/misc/projects/Issue6065/compile-fail.hxml create mode 100644 tests/misc/projects/Issue6065/compile-fail.hxml.stderr create mode 100644 tests/misc/projects/Issue6525/compile-fail.hxml.disabled rename tests/misc/projects/Issue7752/{compile2-fail.hxml => compile2-fail.hxml.disabled} (100%) create mode 100644 tests/misc/projects/Issue8176/Main.hx create mode 100644 tests/misc/projects/Issue8176/compile.hxml create mode 100644 tests/misc/projects/Issue8787/Main1.hx create mode 100644 tests/misc/projects/Issue8787/Main2.hx create mode 100644 tests/misc/projects/Issue8787/compile1-fail.hxml create mode 100644 tests/misc/projects/Issue8787/compile1-fail.hxml.stderr create mode 100644 tests/misc/projects/Issue8787/compile2-fail.hxml create mode 100644 tests/misc/projects/Issue8787/compile2-fail.hxml.stderr create mode 100644 tests/misc/projects/Issue9015/Main.hx create mode 100644 tests/misc/projects/Issue9015/compile-fail.hxml create mode 100644 tests/misc/projects/Issue9015/compile-fail.hxml.stderr create mode 100644 tests/misc/projects/Issue9417/Main.hx create mode 100644 tests/misc/projects/Issue9417/compile-fail.hxml create mode 100644 tests/misc/projects/Issue9417/compile-fail.hxml.stderr create mode 100644 tests/misc/projects/Issue9425/Main.hx create mode 100644 tests/misc/projects/Issue9425/compile-success.hxml create mode 100644 tests/misc/projects/Issue9425/compile-success.hxml.stderr create mode 100644 tests/misc/projects/Issue9514/Main.hx create mode 100644 tests/misc/projects/Issue9514/compile.hxml create mode 100644 tests/misc/projects/Issue9514/compile.hxml.stderr create mode 100644 tests/misc/projects/Issue9556/Main.hx create mode 100644 tests/misc/projects/Issue9556/compile-fail.hxml create mode 100644 tests/misc/projects/Issue9556/compile-fail.hxml.stderr create mode 100644 tests/misc/projects/Issue9612/Main.hx create mode 100644 tests/misc/projects/Issue9612/compile-fail.hxml create mode 100644 tests/misc/projects/Issue9612/compile-fail.hxml.stderr create mode 100644 tests/misc/projects/Issue9619/abstract-dynamic/Main.hx create mode 100644 tests/misc/projects/Issue9619/abstract-dynamic/compile-fail.hxml create mode 100644 tests/misc/projects/Issue9619/abstract-dynamic/compile-fail.hxml.stderr create mode 100644 tests/misc/projects/Issue9619/abstract-expression-inline/Main.hx create mode 100644 tests/misc/projects/Issue9619/abstract-expression-inline/compile-fail.hxml create mode 100644 tests/misc/projects/Issue9619/abstract-expression-inline/compile-fail.hxml.stderr create mode 100644 tests/misc/projects/Issue9619/abstract-final-class/Main.hx create mode 100644 tests/misc/projects/Issue9619/abstract-final-class/compile-fail.hxml create mode 100644 tests/misc/projects/Issue9619/abstract-final-class/compile-fail.hxml.stderr create mode 100644 tests/misc/projects/Issue9619/abstract-final/Main.hx create mode 100644 tests/misc/projects/Issue9619/abstract-final/compile-fail.hxml create mode 100644 tests/misc/projects/Issue9619/abstract-final/compile-fail.hxml.stderr create mode 100644 tests/misc/projects/Issue9619/abstract-inline/Main.hx create mode 100644 tests/misc/projects/Issue9619/abstract-inline/compile-fail.hxml create mode 100644 tests/misc/projects/Issue9619/abstract-inline/compile-fail.hxml.stderr create mode 100644 tests/misc/projects/Issue9619/abstract-interface/Main.hx create mode 100644 tests/misc/projects/Issue9619/abstract-interface/compile-fail.hxml create mode 100644 tests/misc/projects/Issue9619/abstract-interface/compile-fail.hxml.stderr create mode 100644 tests/misc/projects/Issue9619/abstract-static/Main.hx create mode 100644 tests/misc/projects/Issue9619/abstract-static/compile-fail.hxml create mode 100644 tests/misc/projects/Issue9619/abstract-static/compile-fail.hxml.stderr create mode 100644 tests/misc/projects/Issue9619/abstract-structInit/Main.hx create mode 100644 tests/misc/projects/Issue9619/abstract-structInit/compile-fail.hxml create mode 100644 tests/misc/projects/Issue9619/abstract-structInit/compile-fail.hxml.stderr create mode 100644 tests/misc/projects/Issue9619/abstract-with-expression/Main.hx create mode 100644 tests/misc/projects/Issue9619/abstract-with-expression/compile-fail.hxml create mode 100644 tests/misc/projects/Issue9619/abstract-with-expression/compile-fail.hxml.stderr create mode 100644 tests/misc/projects/Issue9619/constructing-abstract/Main.hx create mode 100644 tests/misc/projects/Issue9619/constructing-abstract/compile-fail.hxml create mode 100644 tests/misc/projects/Issue9619/constructing-abstract/compile-fail.hxml.stderr create mode 100644 tests/misc/projects/Issue9619/missing-abstract-on-class/Main.hx create mode 100644 tests/misc/projects/Issue9619/missing-abstract-on-class/compile-fail.hxml create mode 100644 tests/misc/projects/Issue9619/missing-abstract-on-class/compile-fail.hxml.stderr create mode 100644 tests/misc/projects/Issue9619/missing-implementation/Main.hx create mode 100644 tests/misc/projects/Issue9619/missing-implementation/compile-fail.hxml create mode 100644 tests/misc/projects/Issue9619/missing-implementation/compile-fail.hxml.stderr create mode 100644 tests/misc/projects/Issue9619/super-abstract/Main.hx create mode 100644 tests/misc/projects/Issue9619/super-abstract/compile-fail.hxml create mode 100644 tests/misc/projects/Issue9619/super-abstract/compile-fail.hxml.stderr create mode 100644 tests/misc/projects/Issue9631/Fields.hx create mode 100644 tests/misc/projects/Issue9631/Types.hx create mode 100644 tests/misc/projects/Issue9631/compile-fields-fail.hxml create mode 100644 tests/misc/projects/Issue9631/compile-fields-fail.hxml.stderr create mode 100644 tests/misc/projects/Issue9631/compile-types-fail.hxml create mode 100644 tests/misc/projects/Issue9631/compile-types-fail.hxml.stderr create mode 100644 tests/misc/projects/Issue9640/Main.hx create mode 100644 tests/misc/projects/Issue9640/compile-fail.hxml create mode 100644 tests/misc/projects/Issue9640/compile-fail.hxml.stderr create mode 100644 tests/misc/projects/Issue9692/Main.hx create mode 100644 tests/misc/projects/Issue9692/compile-fail.hxml create mode 100644 tests/misc/projects/Issue9692/compile-fail.hxml.stderr create mode 100644 tests/misc/projects/Issue9712/Main.hx create mode 100644 tests/misc/projects/Issue9712/compile.hxml create mode 100644 tests/misc/projects/Issue9769/Main.hx create mode 100644 tests/misc/projects/Issue9769/compile.hxml create mode 100644 tests/misc/projects/Issue9785/Main.hx create mode 100644 tests/misc/projects/Issue9785/compile-fail.hxml create mode 100644 tests/misc/projects/Issue9785/compile-fail.hxml.stderr create mode 100644 tests/misc/projects/Issue9796/Main.hx create mode 100644 tests/misc/projects/Issue9796/compile-fail.hxml create mode 100644 tests/misc/projects/Issue9796/compile-fail.hxml.stderr create mode 100644 tests/misc/projects/Issue9811/Main.hx create mode 100644 tests/misc/projects/Issue9811/Stream.hx create mode 100644 tests/misc/projects/Issue9811/compile.hxml create mode 100644 tests/misc/projects/extern-overloads/ambiguous-static/Main.hx create mode 100644 tests/misc/projects/extern-overloads/ambiguous-static/compile-fail.hxml create mode 100644 tests/misc/projects/extern-overloads/ambiguous-static/compile-fail.hxml.stderr create mode 100644 tests/misc/projects/extern-overloads/amgiuous-call-site/Main.hx create mode 100644 tests/misc/projects/extern-overloads/amgiuous-call-site/compile-fail.hxml create mode 100644 tests/misc/projects/extern-overloads/amgiuous-call-site/compile-fail.hxml.stderr create mode 100644 tests/misc/projects/extern-overloads/missing-override/Main.hx create mode 100644 tests/misc/projects/extern-overloads/missing-override/compile-fail.hxml.disabled create mode 100644 tests/misc/projects/extern-overloads/missing-override/compile-fail.hxml.stderr create mode 100644 tests/misc/projects/extern-overloads/not-not-extern/Main.hx create mode 100644 tests/misc/projects/extern-overloads/not-not-extern/compile-fail.hxml create mode 100644 tests/misc/projects/extern-overloads/not-not-extern/compile-fail.hxml.stderr create mode 100644 tests/misc/projects/extern-overloads/not-on-constructor/Main.hx create mode 100644 tests/misc/projects/extern-overloads/not-on-constructor/compile-fail.hxml create mode 100644 tests/misc/projects/extern-overloads/not-on-constructor/compile-fail.hxml.stderr create mode 100644 tests/misc/projects/inline-constructors/Extern.hx create mode 100644 tests/misc/projects/inline-constructors/ForceInline.hx create mode 100644 tests/misc/projects/inline-constructors/compile-extern-fail.hxml create mode 100644 tests/misc/projects/inline-constructors/compile-extern-fail.hxml.stderr create mode 100644 tests/misc/projects/inline-constructors/compile-force-inline-fail.hxml create mode 100644 tests/misc/projects/inline-constructors/compile-force-inline-fail.hxml.stderr create mode 100644 tests/misc/python/projects/Issue9637/Main.hx create mode 100644 tests/misc/python/projects/Issue9637/build.hxml create mode 100644 tests/misc/python/projects/Issue9666/Main.hx create mode 100644 tests/misc/python/projects/Issue9666/build.hxml create mode 100644 tests/misc/resolution/projects/Issue9367/pack/Mod3.hx create mode 100644 tests/misc/resolution/projects/modulestatics/Duplicate.hx create mode 100644 tests/misc/resolution/projects/modulestatics/Macro.hx create mode 100644 tests/misc/resolution/projects/modulestatics/Main.hx create mode 100644 tests/misc/resolution/projects/modulestatics/ModWithPrivate.hx create mode 100644 tests/misc/resolution/projects/modulestatics/ModWithStaticAndClassStatic.hx create mode 100644 tests/misc/resolution/projects/modulestatics/ModWithStaticAndClassStatic2.hx create mode 100644 tests/misc/resolution/projects/modulestatics/ModuleStaticWithNoMainClass.hx create mode 100644 tests/misc/resolution/projects/modulestatics/ModuleStaticWithNoMainClassInPack.hx create mode 100644 tests/misc/resolution/projects/modulestatics/PrivateAccess.hx create mode 100644 tests/misc/resolution/projects/modulestatics/PrivateImport.hx create mode 100644 tests/misc/resolution/projects/modulestatics/RootMod1.hx create mode 100644 tests/misc/resolution/projects/modulestatics/RootMod2.hx create mode 100644 tests/misc/resolution/projects/modulestatics/RootMod3.hx create mode 100644 tests/misc/resolution/projects/modulestatics/RootMod4.hx create mode 100644 tests/misc/resolution/projects/modulestatics/Wildcard.hx create mode 100644 tests/misc/resolution/projects/modulestatics/compile-duplicate-fail.hxml create mode 100644 tests/misc/resolution/projects/modulestatics/compile-duplicate-fail.hxml.stderr create mode 100644 tests/misc/resolution/projects/modulestatics/compile-moduleStaticWithNoMainClass-fail.hxml create mode 100644 tests/misc/resolution/projects/modulestatics/compile-moduleStaticWithNoMainClass-fail.hxml.stderr create mode 100644 tests/misc/resolution/projects/modulestatics/compile-moduleStaticWithNoMainClassInPack-fail.hxml create mode 100644 tests/misc/resolution/projects/modulestatics/compile-moduleStaticWithNoMainClassInPack-fail.hxml.stderr create mode 100644 tests/misc/resolution/projects/modulestatics/compile-private-fail.hxml create mode 100644 tests/misc/resolution/projects/modulestatics/compile-private-fail.hxml.stderr create mode 100644 tests/misc/resolution/projects/modulestatics/compile-private2-fail.hxml create mode 100644 tests/misc/resolution/projects/modulestatics/compile-private2-fail.hxml.stderr create mode 100644 tests/misc/resolution/projects/modulestatics/compile.hxml create mode 100644 tests/misc/resolution/projects/modulestatics/pack/InnerMod.hx create mode 100644 tests/misc/resolution/projects/modulestatics/pack/Mod1.hx create mode 100644 tests/misc/resolution/projects/modulestatics/pack/Mod2.hx create mode 100644 tests/misc/resolution/projects/modulestatics/pack/inner/InnerMod.hx create mode 100644 tests/misc/resolution/projects/modulestatics/pack/inner/Test.hx create mode 100644 tests/misc/resolution/projects/modulestatics/pack/shadow/Test.hx create mode 100644 tests/misc/resolution/projects/spec/ModWithPrivate.hx create mode 100644 tests/misc/resolution/projects/spec/PrivateImport.hx create mode 100644 tests/misc/resolution/projects/spec/compile-private-fail.hxml create mode 100644 tests/misc/resolution/projects/spec/compile-private-fail.hxml.stderr create mode 100644 tests/optimization/src/TestInlineConstructors.hx create mode 100644 tests/optimization/src/issues/Issue9778.hx create mode 100644 tests/server/src/cases/display/InheritDoc.hx create mode 100644 tests/server/src/cases/display/issues/Issue10008.hx create mode 100644 tests/server/src/cases/display/issues/Issue8073.hx create mode 100644 tests/server/src/cases/display/issues/Issue9183.hx create mode 100644 tests/server/src/cases/display/issues/Issue9266.hx create mode 100644 tests/server/src/cases/display/issues/Issue9383.hx create mode 100644 tests/server/src/cases/display/issues/Issue9446.hx create mode 100644 tests/server/src/cases/display/issues/Issue9463.hx create mode 100644 tests/server/src/cases/display/issues/Issue9790.hx create mode 100644 tests/server/src/cases/display/issues/Issue9824.hx create mode 100644 tests/server/src/cases/display/issues/Issue9956.hx create mode 100644 tests/server/src/utils/macro/DebugFailures.hx create mode 100644 tests/server/test/templates/InheritDocTypes.hx create mode 100644 tests/server/test/templates/Issue9918.hx create mode 100644 tests/server/test/templates/Issue9956Types.hx delete mode 100644 tests/server/test/templates/issues/Issue9087/A.hx create mode 100644 tests/sys/src/db/SqliteSetup.hx create mode 100644 tests/sys/src/db/TestSqliteConnection.hx create mode 100644 tests/sys/src/db/TestSqliteResultSet.hx create mode 100644 tests/threads-old/build.hxml rename tests/{threads => threads-old}/res/tree1.txt (100%) create mode 100644 tests/threads-old/src/Main.hx rename tests/{threads => threads-old}/src/cases/DequeBrackets.hx (100%) rename tests/{threads => threads-old}/src/cases/Issue3767.hx (86%) rename tests/{threads => threads-old}/src/cases/Issue4878.hx (78%) rename tests/{threads => threads-old}/src/cases/Issue8063.hx (73%) rename tests/{threads => threads-old}/src/cases/Issue9863.hx (100%) rename tests/{threads => threads-old}/src/cases/TestThreads.hx (98%) rename tests/{threads => threads-old}/src/cases/WeirdTreeSum.hx (97%) create mode 100644 tests/threads-old/src/import.hx create mode 100644 tests/threads/src/cases/TestElasticThreadPool.hx create mode 100644 tests/threads/src/cases/TestEvents.hx create mode 100644 tests/threads/src/cases/TestFixedThreadPool.hx create mode 100644 tests/threads/src/cases/TestMainLoop.hx create mode 100644 tests/threads/src/cases/TestTimer.hx create mode 100644 tests/threads/src/misc/TestThreadPoolBase.hx create mode 100644 tests/unit/.vscode/settings.json delete mode 100644 tests/unit/compile-cs-travis.hxml delete mode 100644 tests/unit/compile-cs-unsafe-travis.hxml create mode 100644 tests/unit/compile-jvm-only.hxml delete mode 100644 tests/unit/compile-remoting.hxml create mode 100644 tests/unit/native_cs/src/haxe/test/AttrWithNullType.cs delete mode 100644 tests/unit/src/unit/RemotingServer.hx create mode 100644 tests/unit/src/unit/TestConstrainedMonomorphs.hx create mode 100644 tests/unit/src/unit/TestModuleStatics.hx create mode 100644 tests/unit/src/unit/TestModuleStaticsMacro.hx create mode 100644 tests/unit/src/unit/TestOverloadsForEveryone.hx delete mode 100644 tests/unit/src/unit/TestRemoting.hx create mode 100644 tests/unit/src/unit/TestRest.hx create mode 100644 tests/unit/src/unit/hxcpp_issues/Issue10100.hx create mode 100644 tests/unit/src/unit/issues/Issue10007.hx create mode 100644 tests/unit/src/unit/issues/Issue10012.hx create mode 100644 tests/unit/src/unit/issues/Issue10018.hx create mode 100644 tests/unit/src/unit/issues/Issue10030.hx create mode 100644 tests/unit/src/unit/issues/Issue10041.hx create mode 100644 tests/unit/src/unit/issues/Issue10052.hx create mode 100644 tests/unit/src/unit/issues/Issue10057.hx create mode 100644 tests/unit/src/unit/issues/Issue10073.hx create mode 100644 tests/unit/src/unit/issues/Issue10083.hx create mode 100644 tests/unit/src/unit/issues/Issue10098.hx create mode 100644 tests/unit/src/unit/issues/Issue1284.hx rename tests/unit/src/{unitstd => unit/issues}/Issue3067.hx (93%) create mode 100644 tests/unit/src/unit/issues/Issue3297.hx delete mode 100644 tests/unit/src/unit/issues/Issue3388.hx delete mode 100644 tests/unit/src/unit/issues/Issue3531.hx create mode 100644 tests/unit/src/unit/issues/Issue3607.hx create mode 100644 tests/unit/src/unit/issues/Issue5207.hx create mode 100644 tests/unit/src/unit/issues/Issue7599.hx create mode 100644 tests/unit/src/unit/issues/Issue7656.hx create mode 100644 tests/unit/src/unit/issues/Issue7942.hx create mode 100644 tests/unit/src/unit/issues/Issue8145.hx create mode 100644 tests/unit/src/unit/issues/Issue8427.hx create mode 100644 tests/unit/src/unit/issues/Issue8760.hx create mode 100644 tests/unit/src/unit/issues/Issue8966.hx create mode 100644 tests/unit/src/unit/issues/Issue8984.hx create mode 100644 tests/unit/src/unit/issues/Issue9123.hx create mode 100644 tests/unit/src/unit/issues/Issue9144.hx create mode 100644 tests/unit/src/unit/issues/Issue9309.hx create mode 100644 tests/unit/src/unit/issues/Issue9370.hx create mode 100644 tests/unit/src/unit/issues/Issue9372.hx create mode 100644 tests/unit/src/unit/issues/Issue9403.hx create mode 100644 tests/unit/src/unit/issues/Issue9405.hx create mode 100644 tests/unit/src/unit/issues/Issue9438.hx create mode 100644 tests/unit/src/unit/issues/Issue9491.hx create mode 100644 tests/unit/src/unit/issues/Issue9498.hx create mode 100644 tests/unit/src/unit/issues/Issue9516.hx create mode 100644 tests/unit/src/unit/issues/Issue9542.hx create mode 100644 tests/unit/src/unit/issues/Issue9548.hx create mode 100644 tests/unit/src/unit/issues/Issue9554.hx create mode 100644 tests/unit/src/unit/issues/Issue9560.hx create mode 100644 tests/unit/src/unit/issues/Issue9565.hx create mode 100644 tests/unit/src/unit/issues/Issue9576.hx create mode 100644 tests/unit/src/unit/issues/Issue9577.hx create mode 100644 tests/unit/src/unit/issues/Issue9579.hx create mode 100644 tests/unit/src/unit/issues/Issue9590.hx create mode 100644 tests/unit/src/unit/issues/Issue9593.hx create mode 100644 tests/unit/src/unit/issues/Issue9594.hx create mode 100644 tests/unit/src/unit/issues/Issue9597.hx create mode 100644 tests/unit/src/unit/issues/Issue9601.hx create mode 100644 tests/unit/src/unit/issues/Issue9603.hx create mode 100644 tests/unit/src/unit/issues/Issue9619.hx create mode 100644 tests/unit/src/unit/issues/Issue9627.hx create mode 100644 tests/unit/src/unit/issues/Issue9652.hx create mode 100644 tests/unit/src/unit/issues/Issue9661.hx create mode 100644 tests/unit/src/unit/issues/Issue9667.hx create mode 100644 tests/unit/src/unit/issues/Issue9680.hx create mode 100644 tests/unit/src/unit/issues/Issue9681.hx create mode 100644 tests/unit/src/unit/issues/Issue9688.hx create mode 100644 tests/unit/src/unit/issues/Issue9710.hx create mode 100644 tests/unit/src/unit/issues/Issue9715.hx create mode 100644 tests/unit/src/unit/issues/Issue9719.hx create mode 100644 tests/unit/src/unit/issues/Issue9721.hx create mode 100644 tests/unit/src/unit/issues/Issue9735.hx create mode 100644 tests/unit/src/unit/issues/Issue9736.hx create mode 100644 tests/unit/src/unit/issues/Issue9737.hx create mode 100644 tests/unit/src/unit/issues/Issue9741.hx create mode 100644 tests/unit/src/unit/issues/Issue9744.hx create mode 100644 tests/unit/src/unit/issues/Issue9745.hx create mode 100644 tests/unit/src/unit/issues/Issue9746.hx create mode 100644 tests/unit/src/unit/issues/Issue9749.hx create mode 100644 tests/unit/src/unit/issues/Issue9755.hx create mode 100644 tests/unit/src/unit/issues/Issue9757.hx create mode 100644 tests/unit/src/unit/issues/Issue9758.hx create mode 100644 tests/unit/src/unit/issues/Issue9759.hx create mode 100644 tests/unit/src/unit/issues/Issue9761.hx create mode 100644 tests/unit/src/unit/issues/Issue9764.hx create mode 100644 tests/unit/src/unit/issues/Issue9770.hx create mode 100644 tests/unit/src/unit/issues/Issue9771.hx create mode 100644 tests/unit/src/unit/issues/Issue9777.hx create mode 100644 tests/unit/src/unit/issues/Issue9784.hx create mode 100644 tests/unit/src/unit/issues/Issue9791.hx create mode 100644 tests/unit/src/unit/issues/Issue9795.hx create mode 100644 tests/unit/src/unit/issues/Issue9797.hx create mode 100644 tests/unit/src/unit/issues/Issue9806.hx create mode 100644 tests/unit/src/unit/issues/Issue9807.hx create mode 100644 tests/unit/src/unit/issues/Issue9812.hx create mode 100644 tests/unit/src/unit/issues/Issue9828.hx create mode 100644 tests/unit/src/unit/issues/Issue9836.hx create mode 100644 tests/unit/src/unit/issues/Issue9854.hx create mode 100644 tests/unit/src/unit/issues/Issue9874.hx create mode 100644 tests/unit/src/unit/issues/Issue9883.hx create mode 100644 tests/unit/src/unit/issues/Issue9894.hx create mode 100644 tests/unit/src/unit/issues/Issue9899.hx create mode 100644 tests/unit/src/unit/issues/Issue9904.hx create mode 100644 tests/unit/src/unit/issues/Issue9905.hx create mode 100644 tests/unit/src/unit/issues/Issue9938.hx create mode 100644 tests/unit/src/unit/issues/Issue9946.hx create mode 100644 tests/unit/src/unit/issues/misc/Issue5207Macro.hx create mode 100644 tests/unit/src/unit/issues/misc/Issue9661Macro.hx rename tests/unit/src/unitstd/{IntIterator.hx => IntIterator.unit.hx} (90%) rename tests/unit/src/unitstd/haxe/{Http.unit2.hx => Http.unit.hx.disabled} (100%) rename tests/unit/src/unitstd/haxe/io/{ArrayBufferView.hx => ArrayBufferView.unit.hx} (100%) diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml new file mode 100644 index 00000000..c44505fb --- /dev/null +++ b/.github/workflows/main.yml @@ -0,0 +1,918 @@ +# DO NOT EDIT. Generated from /extra/github-actions +# TODO: support skip ci (https://github.community/t/github-actions-does-not-respect-skip-ci/17325/8) + +name: CI +on: [push, pull_request] + +jobs: + cancel: + name: "Cancel previous runs" + runs-on: ubuntu-latest + timeout-minutes: 3 + steps: + - uses: styfle/cancel-workflow-action@0.3.1 + with: + workflow_id: 1447568 + access_token: ${{ github.token }} + + windows64-build: + runs-on: windows-latest + env: + ACTIONS_ALLOW_UNSECURE_COMMANDS: true + PLATFORM: windows64 + OPAMYES: 1 + CYG_MIRROR: http://mirrors.kernel.org/sourceware/cygwin/ + ARCH: 64 + MINGW_ARCH: x86_64 + CYGWIN_SETUP: https://cygwin.com/setup-x86_64.exe + CYG_ROOT: C:/cygwin64 + steps: + - uses: actions/checkout@main + with: + submodules: recursive + + - name: Install Neko using snapshot from S3 (Unix) + if: ${{ !startsWith(env.PLATFORM, 'windows') }} + run: | + set -ex + + curl -sSL https://build.haxe.org/builds/neko/$PLATFORM/neko_latest.tar.gz -o $RUNNER_TEMP/neko_latest.tar.gz + tar -xf $RUNNER_TEMP/neko_latest.tar.gz -C $RUNNER_TEMP + NEKOPATH=`echo $RUNNER_TEMP/neko-*-*` + sudo mkdir -p /usr/local/bin + sudo mkdir -p /usr/local/lib/neko + sudo ln -s $NEKOPATH/{neko,nekoc,nekoml,nekotools} /usr/local/bin/ + sudo ln -s $NEKOPATH/libneko.* /usr/local/lib/ + sudo ln -s $NEKOPATH/*.ndll /usr/local/lib/neko/ + echo "NEKOPATH=$NEKOPATH" >> $GITHUB_ENV + + - name: Install Neko using snapshot from S3 (Windows) + if: ${{ startsWith(env.PLATFORM, 'windows') }} + shell: pwsh + run: | + Invoke-WebRequest https://build.haxe.org/builds/neko/$env:PLATFORM/neko_latest.zip -OutFile $env:RUNNER_TEMP/neko_latest.zip + Expand-Archive $env:RUNNER_TEMP/neko_latest.zip -DestinationPath $env:RUNNER_TEMP + $NEKOPATH = Get-ChildItem $env:RUNNER_TEMP/neko-*-* + echo "$NEKOPATH" >> $env:GITHUB_PATH + echo "NEKOPATH=$NEKOPATH" >> $env:GITHUB_ENV + + - name: Print Neko version + run: neko -version 2>&1 + + - name: choco install nsis + uses: nick-invision/retry@v1 + with: + timeout_minutes: 10 + max_attempts: 10 + command: choco install --no-progress nsis.portable --version 3.02 -y + - name: choco install things + shell: pwsh + run: choco install --no-progress curl wget 7zip.portable -y + - name: Prepend Chocolatey path + shell: pwsh + run: Write-Host "::add-path::C:\ProgramData\chocolatey\bin" + + - name: Install OCaml and OCaml libraries + shell: pwsh + run: | + Set-PSDebug -Trace 1 + curl.exe -fsSL -o cygwin-setup.exe --retry 3 $($env:CYGWIN_SETUP) + Start-Process -FilePath "cygwin-setup.exe" -ArgumentList "-B -q -R $($env:CYG_ROOT) -l C:/tmp -s $($env:CYG_MIRROR) -P default -P make -P git -P zlib-devel -P rsync -P patch -P diffutils -P curl -P unzip -P tar -P m4 -P perl -P libpcre-devel -P mbedtls-devel -P mingw64-$($env:MINGW_ARCH)-zlib -P mingw64-$($env:MINGW_ARCH)-gcc-core -P mingw64-$($env:MINGW_ARCH)-pcre -P perl-IPC-System-Simple" -Wait + curl.exe -fsSL -o "opam.tar.xz" --retry 3 https://github.com/fdopen/opam-repository-mingw/releases/download/0.0.0.2/opam$($env:ARCH).tar.xz + curl.exe -fsSL -o "libmbedtls.tar.xz" --retry 3 https://github.com/Simn/mingw64-mbedtls/releases/download/2.16.3/mingw64-$($env:MINGW_ARCH)-mbedtls-2.16.3-1.tar.xz + & "$($env:CYG_ROOT)/bin/bash.exe" @('-lc', 'curl -L https://cpanmin.us | perl - App::cpanminus') + & "$($env:CYG_ROOT)/bin/bash.exe" @('-lc', 'cpanm String::ShellQuote') + & "$($env:CYG_ROOT)/bin/bash.exe" @('-lc', 'echo "$OLDPWD"') + & "$($env:CYG_ROOT)/bin/bash.exe" @('-lc', 'cd "$OLDPWD" && tar -C / -xvf libmbedtls.tar.xz') + & "$($env:CYG_ROOT)/bin/bash.exe" @('-lc', 'cd "$OLDPWD" && tar -xf opam.tar.xz') + & "$($env:CYG_ROOT)/bin/bash.exe" @('-lc', 'cd "$OLDPWD" && bash opam${ARCH}/install.sh') + & "$($env:CYG_ROOT)/bin/bash.exe" @('-lc', 'opam init mingw "https://github.com/fdopen/opam-repository-mingw.git#opam2" --comp 4.07.0+mingw${ARCH}c --switch 4.07.0+mingw${ARCH}c --auto-setup --yes 2>&1') + & "$($env:CYG_ROOT)/bin/bash.exe" @('-lc', 'opam update --yes 2>&1') + & "$($env:CYG_ROOT)/bin/bash.exe" @('-lc', 'cd "$OLDPWD" && opam pin add haxe . --kind=path --no-action --yes 2>&1') + & "$($env:CYG_ROOT)/bin/bash.exe" @('-lc', 'opam install haxe --deps-only --yes 2>&1') + & "$($env:CYG_ROOT)/bin/bash.exe" @('-lc', 'opam pin add luv https://github.com/aantron/luv.git#44db25c2b2669f9d1373377006a4d5850e0820e3 --yes 2>&1') + & "$($env:CYG_ROOT)/bin/bash.exe" @('-lc', 'opam list') + & "$($env:CYG_ROOT)/bin/bash.exe" @('-lc', 'ocamlopt -v') + + - name: Expose mingw dll files + shell: pwsh + run: Write-Host "::add-path::${env:CYG_ROOT}/usr/$($env:MINGW_ARCH)-w64-mingw32/sys-root/mingw/bin" + + - name: Set ADD_REVISION=1 for non-release + if: ${{ !startsWith(github.ref, 'refs/tags/') }} + shell: pwsh + run: echo "ADD_REVISION=1" >> $Env:GITHUB_ENV + + - name: Build Haxe + shell: pwsh + run: | + Set-PSDebug -Trace 1 + & "$($env:CYG_ROOT)/bin/bash.exe" @('-lc', 'cd "$OLDPWD" && opam config exec -- make -s -f Makefile.win -j`nproc` haxe 2>&1') + & "$($env:CYG_ROOT)/bin/bash.exe" @('-lc', 'cd "$OLDPWD" && opam config exec -- make -s -f Makefile.win haxelib 2>&1') + & "$($env:CYG_ROOT)/bin/bash.exe" @('-lc', 'cd "$OLDPWD" && opam config exec -- make -f Makefile.win echo_package_files package_bin package_installer_win package_choco 2>&1') + dir out + & "$($env:CYG_ROOT)/bin/bash.exe" @('-lc', 'cd "$OLDPWD" && cygcheck ./haxe.exe') + & "$($env:CYG_ROOT)/bin/bash.exe" @('-lc', 'cd "$OLDPWD" && cygcheck ./haxelib.exe') + & "$($env:CYG_ROOT)/bin/bash.exe" @('-lc', 'cd "$OLDPWD" && ls ./out') + + - name: Upload artifact + uses: actions/upload-artifact@v1.0.0 + with: + name: win${{env.ARCH}}Binaries + path: out + + + windows-build: + runs-on: windows-latest + env: + ACTIONS_ALLOW_UNSECURE_COMMANDS: true + PLATFORM: windows + OPAMYES: 1 + CYG_MIRROR: http://mirrors.kernel.org/sourceware/cygwin/ + ARCH: 32 + MINGW_ARCH: i686 + CYGWIN_SETUP: https://cygwin.com/setup-x86.exe + CYG_ROOT: C:/cygwin + steps: + - uses: actions/checkout@main + with: + submodules: recursive + + - name: Install Neko using snapshot from S3 (Unix) + if: ${{ !startsWith(env.PLATFORM, 'windows') }} + run: | + set -ex + + curl -sSL https://build.haxe.org/builds/neko/$PLATFORM/neko_latest.tar.gz -o $RUNNER_TEMP/neko_latest.tar.gz + tar -xf $RUNNER_TEMP/neko_latest.tar.gz -C $RUNNER_TEMP + NEKOPATH=`echo $RUNNER_TEMP/neko-*-*` + sudo mkdir -p /usr/local/bin + sudo mkdir -p /usr/local/lib/neko + sudo ln -s $NEKOPATH/{neko,nekoc,nekoml,nekotools} /usr/local/bin/ + sudo ln -s $NEKOPATH/libneko.* /usr/local/lib/ + sudo ln -s $NEKOPATH/*.ndll /usr/local/lib/neko/ + echo "NEKOPATH=$NEKOPATH" >> $GITHUB_ENV + + - name: Install Neko using snapshot from S3 (Windows) + if: ${{ startsWith(env.PLATFORM, 'windows') }} + shell: pwsh + run: | + Invoke-WebRequest https://build.haxe.org/builds/neko/$env:PLATFORM/neko_latest.zip -OutFile $env:RUNNER_TEMP/neko_latest.zip + Expand-Archive $env:RUNNER_TEMP/neko_latest.zip -DestinationPath $env:RUNNER_TEMP + $NEKOPATH = Get-ChildItem $env:RUNNER_TEMP/neko-*-* + echo "$NEKOPATH" >> $env:GITHUB_PATH + echo "NEKOPATH=$NEKOPATH" >> $env:GITHUB_ENV + + - name: Print Neko version + run: neko -version 2>&1 + + - name: choco install nsis + uses: nick-invision/retry@v1 + with: + timeout_minutes: 10 + max_attempts: 10 + command: choco install --no-progress nsis.portable --version 3.02 -y + - name: choco install things + shell: pwsh + run: choco install --no-progress curl wget 7zip.portable -y + - name: Prepend Chocolatey path + shell: pwsh + run: Write-Host "::add-path::C:\ProgramData\chocolatey\bin" + + - name: Install OCaml and OCaml libraries + shell: pwsh + run: | + Set-PSDebug -Trace 1 + curl.exe -fsSL -o cygwin-setup.exe --retry 3 $($env:CYGWIN_SETUP) + Start-Process -FilePath "cygwin-setup.exe" -ArgumentList "-B -q -R $($env:CYG_ROOT) -l C:/tmp -s $($env:CYG_MIRROR) -P default -P make -P git -P zlib-devel -P rsync -P patch -P diffutils -P curl -P unzip -P tar -P m4 -P perl -P libpcre-devel -P mbedtls-devel -P mingw64-$($env:MINGW_ARCH)-zlib -P mingw64-$($env:MINGW_ARCH)-gcc-core -P mingw64-$($env:MINGW_ARCH)-pcre -P perl-IPC-System-Simple" -Wait + curl.exe -fsSL -o "opam.tar.xz" --retry 3 https://github.com/fdopen/opam-repository-mingw/releases/download/0.0.0.2/opam$($env:ARCH).tar.xz + curl.exe -fsSL -o "libmbedtls.tar.xz" --retry 3 https://github.com/Simn/mingw64-mbedtls/releases/download/2.16.3/mingw64-$($env:MINGW_ARCH)-mbedtls-2.16.3-1.tar.xz + & "$($env:CYG_ROOT)/bin/bash.exe" @('-lc', 'curl -L https://cpanmin.us | perl - App::cpanminus') + & "$($env:CYG_ROOT)/bin/bash.exe" @('-lc', 'cpanm String::ShellQuote') + & "$($env:CYG_ROOT)/bin/bash.exe" @('-lc', 'echo "$OLDPWD"') + & "$($env:CYG_ROOT)/bin/bash.exe" @('-lc', 'cd "$OLDPWD" && tar -C / -xvf libmbedtls.tar.xz') + & "$($env:CYG_ROOT)/bin/bash.exe" @('-lc', 'cd "$OLDPWD" && tar -xf opam.tar.xz') + & "$($env:CYG_ROOT)/bin/bash.exe" @('-lc', 'cd "$OLDPWD" && bash opam${ARCH}/install.sh') + & "$($env:CYG_ROOT)/bin/bash.exe" @('-lc', 'opam init mingw "https://github.com/fdopen/opam-repository-mingw.git#opam2" --comp 4.07.0+mingw${ARCH}c --switch 4.07.0+mingw${ARCH}c --auto-setup --yes 2>&1') + & "$($env:CYG_ROOT)/bin/bash.exe" @('-lc', 'opam update --yes 2>&1') + & "$($env:CYG_ROOT)/bin/bash.exe" @('-lc', 'cd "$OLDPWD" && opam pin add haxe . --kind=path --no-action --yes 2>&1') + & "$($env:CYG_ROOT)/bin/bash.exe" @('-lc', 'opam install haxe --deps-only --yes 2>&1') + & "$($env:CYG_ROOT)/bin/bash.exe" @('-lc', 'opam pin add luv https://github.com/aantron/luv.git#44db25c2b2669f9d1373377006a4d5850e0820e3 --yes 2>&1') + & "$($env:CYG_ROOT)/bin/bash.exe" @('-lc', 'opam list') + & "$($env:CYG_ROOT)/bin/bash.exe" @('-lc', 'ocamlopt -v') + + - name: Expose mingw dll files + shell: pwsh + run: Write-Host "::add-path::${env:CYG_ROOT}/usr/$($env:MINGW_ARCH)-w64-mingw32/sys-root/mingw/bin" + + - name: Set ADD_REVISION=1 for non-release + if: ${{ !startsWith(github.ref, 'refs/tags/') }} + shell: pwsh + run: echo "ADD_REVISION=1" >> $Env:GITHUB_ENV + + - name: Build Haxe + shell: pwsh + run: | + Set-PSDebug -Trace 1 + & "$($env:CYG_ROOT)/bin/bash.exe" @('-lc', 'cd "$OLDPWD" && opam config exec -- make -s -f Makefile.win -j`nproc` haxe 2>&1') + & "$($env:CYG_ROOT)/bin/bash.exe" @('-lc', 'cd "$OLDPWD" && opam config exec -- make -s -f Makefile.win haxelib 2>&1') + & "$($env:CYG_ROOT)/bin/bash.exe" @('-lc', 'cd "$OLDPWD" && opam config exec -- make -f Makefile.win echo_package_files package_bin package_installer_win package_choco 2>&1') + dir out + & "$($env:CYG_ROOT)/bin/bash.exe" @('-lc', 'cd "$OLDPWD" && cygcheck ./haxe.exe') + & "$($env:CYG_ROOT)/bin/bash.exe" @('-lc', 'cd "$OLDPWD" && cygcheck ./haxelib.exe') + & "$($env:CYG_ROOT)/bin/bash.exe" @('-lc', 'cd "$OLDPWD" && ls ./out') + + - name: Upload artifact + uses: actions/upload-artifact@v1.0.0 + with: + name: win${{env.ARCH}}Binaries + path: out + + + linux-build: + runs-on: ubuntu-latest + env: + PLATFORM: linux64 + OPAMYES: 1 + steps: + - uses: actions/checkout@main + with: + submodules: recursive + + - name: Install Neko using snapshot from S3 (Unix) + if: ${{ !startsWith(env.PLATFORM, 'windows') }} + run: | + set -ex + + curl -sSL https://build.haxe.org/builds/neko/$PLATFORM/neko_latest.tar.gz -o $RUNNER_TEMP/neko_latest.tar.gz + tar -xf $RUNNER_TEMP/neko_latest.tar.gz -C $RUNNER_TEMP + NEKOPATH=`echo $RUNNER_TEMP/neko-*-*` + sudo mkdir -p /usr/local/bin + sudo mkdir -p /usr/local/lib/neko + sudo ln -s $NEKOPATH/{neko,nekoc,nekoml,nekotools} /usr/local/bin/ + sudo ln -s $NEKOPATH/libneko.* /usr/local/lib/ + sudo ln -s $NEKOPATH/*.ndll /usr/local/lib/neko/ + echo "NEKOPATH=$NEKOPATH" >> $GITHUB_ENV + + - name: Install Neko using snapshot from S3 (Windows) + if: ${{ startsWith(env.PLATFORM, 'windows') }} + shell: pwsh + run: | + Invoke-WebRequest https://build.haxe.org/builds/neko/$env:PLATFORM/neko_latest.zip -OutFile $env:RUNNER_TEMP/neko_latest.zip + Expand-Archive $env:RUNNER_TEMP/neko_latest.zip -DestinationPath $env:RUNNER_TEMP + $NEKOPATH = Get-ChildItem $env:RUNNER_TEMP/neko-*-* + echo "$NEKOPATH" >> $env:GITHUB_PATH + echo "NEKOPATH=$NEKOPATH" >> $env:GITHUB_ENV + + - name: Print Neko version + run: neko -version 2>&1 + + - name: Install dependencies + run: | + set -ex + sudo add-apt-repository ppa:avsm/ppa -y # provides OPAM 2 + sudo add-apt-repository ppa:haxe/ocaml -y # provides newer version of mbedtls + sudo apt-get update -qqy + sudo apt-get install -qqy ocaml-nox camlp5 opam libpcre3-dev zlib1g-dev libgtk2.0-dev libmbedtls-dev ninja-build libstring-shellquote-perl + + - name: Install OCaml libraries + run: | + set -ex + opam init # --disable-sandboxing + opam update + opam pin add haxe . --no-action + opam install haxe --deps-only + opam list + ocamlopt -v + + - name: Set ADD_REVISION=1 for non-release + if: ${{ !startsWith(github.ref, 'refs/tags/') }} + run: echo "ADD_REVISION=1" >> $GITHUB_ENV + + - name: Build Haxe + run: | + set -ex + eval $(opam env) + opam config exec -- make -s -j`nproc` STATICLINK=1 haxe + opam config exec -- make -s haxelib + make -s package_unix + ls -l out + ldd -v ./haxe + ldd -v ./haxelib + + # https://stackoverflow.com/questions/58033366/how-to-get-current-branch-within-github-actions + - name: Extract branch name + id: extract_branch + shell: bash + run: echo "##[set-output name=branch;]$(echo ${GITHUB_REF#refs/heads/})" + + - name: Build xmldoc + run: | + set -ex + make -s xmldoc + cat >extra/doc/info.json <> $GITHUB_ENV + + - name: Install Neko using snapshot from S3 (Windows) + if: ${{ startsWith(env.PLATFORM, 'windows') }} + shell: pwsh + run: | + Invoke-WebRequest https://build.haxe.org/builds/neko/$env:PLATFORM/neko_latest.zip -OutFile $env:RUNNER_TEMP/neko_latest.zip + Expand-Archive $env:RUNNER_TEMP/neko_latest.zip -DestinationPath $env:RUNNER_TEMP + $NEKOPATH = Get-ChildItem $env:RUNNER_TEMP/neko-*-* + echo "$NEKOPATH" >> $env:GITHUB_PATH + echo "NEKOPATH=$NEKOPATH" >> $env:GITHUB_ENV + + - name: Print Neko version + run: neko -version 2>&1 + + - name: Install dependencies + run: | + set -ex + brew uninstall openssl@1.0.2t || echo + brew uninstall python@2.7.17 || echo + brew untap local/openssl || echo + brew untap local/python2 || echo + brew update + # brew unlink python@2 + brew bundle --file=tests/Brewfile --no-upgrade || brew link --overwrite awscli + brew install cpanminus + cpanm IPC::System::Simple + cpanm String::ShellQuote + + - name: Install OCaml libraries + run: | + set -ex + opam init # --disable-sandboxing + opam update + opam pin add haxe . --no-action + opam install haxe --deps-only + opam list + ocamlopt -v + + - name: Set ADD_REVISION=1 for non-release + if: ${{ !startsWith(github.ref, 'refs/tags/') }} + run: echo "ADD_REVISION=1" >> $GITHUB_ENV + + - name: Build Haxe + run: | + set -ex + eval $(opam env) + opam config exec -- make -s -j`sysctl -n hw.ncpu` STATICLINK=1 "LIB_PARAMS=/usr/local/opt/zlib/lib/libz.a /usr/local/lib/libpcre.a /usr/local/lib/libmbedtls.a /usr/local/lib/libmbedcrypto.a /usr/local/lib/libmbedx509.a -cclib '-framework Security -framework CoreFoundation'" haxe + opam config exec -- make -s haxelib + make -s package_unix package_installer_mac + ls -l out + otool -L ./haxe + otool -L ./haxelib + + - name: Upload artifact + uses: actions/upload-artifact@v1.0.0 + with: + name: macBinaries + path: out + + + windows64-test: + needs: windows64-build + runs-on: windows-latest + env: + ACTIONS_ALLOW_UNSECURE_COMMANDS: true + PLATFORM: windows64 + TEST: ${{matrix.target}} + HXCPP_COMPILE_CACHE: ~/hxcache + ARCH: 64 + strategy: + fail-fast: false + matrix: + # TODO enable lua after https://github.com/HaxeFoundation/haxe/issues/5024 + target: [macro, js, hl, cpp, 'java,jvm', cs, php, python, neko] + steps: + - uses: actions/checkout@main + with: + submodules: recursive + - uses: actions/download-artifact@v1 + with: + name: win${{env.ARCH}}Binaries + + - name: Install Neko using snapshot from S3 (Unix) + if: ${{ !startsWith(env.PLATFORM, 'windows') }} + run: | + set -ex + + curl -sSL https://build.haxe.org/builds/neko/$PLATFORM/neko_latest.tar.gz -o $RUNNER_TEMP/neko_latest.tar.gz + tar -xf $RUNNER_TEMP/neko_latest.tar.gz -C $RUNNER_TEMP + NEKOPATH=`echo $RUNNER_TEMP/neko-*-*` + sudo mkdir -p /usr/local/bin + sudo mkdir -p /usr/local/lib/neko + sudo ln -s $NEKOPATH/{neko,nekoc,nekoml,nekotools} /usr/local/bin/ + sudo ln -s $NEKOPATH/libneko.* /usr/local/lib/ + sudo ln -s $NEKOPATH/*.ndll /usr/local/lib/neko/ + echo "NEKOPATH=$NEKOPATH" >> $GITHUB_ENV + + - name: Install Neko using snapshot from S3 (Windows) + if: ${{ startsWith(env.PLATFORM, 'windows') }} + shell: pwsh + run: | + Invoke-WebRequest https://build.haxe.org/builds/neko/$env:PLATFORM/neko_latest.zip -OutFile $env:RUNNER_TEMP/neko_latest.zip + Expand-Archive $env:RUNNER_TEMP/neko_latest.zip -DestinationPath $env:RUNNER_TEMP + $NEKOPATH = Get-ChildItem $env:RUNNER_TEMP/neko-*-* + echo "$NEKOPATH" >> $env:GITHUB_PATH + echo "NEKOPATH=$NEKOPATH" >> $env:GITHUB_ENV + + - name: Print Neko version + run: neko -version 2>&1 + + # - name: Quick test + # shell: pwsh + # run: | + # $DOWNLOADDIR="./win$($env:ARCH)Binaries" + # new-item -Name $DOWNLOADDIR -ItemType directory + # Invoke-WebRequest https://build.haxe.org/builds/haxe/$env:PLATFORM/haxe_latest.zip -OutFile $DOWNLOADDIR/haxe_bin.zip + + - name: Setup Haxe + shell: pwsh + run: | + $DOWNLOADDIR="./win$($env:ARCH)Binaries" + Expand-Archive $DOWNLOADDIR/*_bin.zip -DestinationPath $DOWNLOADDIR + Set-PSDebug -Trace 1 + $HAXEPATH = Get-ChildItem $DOWNLOADDIR/haxe_*_* -Directory + Write-Host "::add-path::$HAXEPATH" + Write-Host "::set-env name=HAXELIB_ROOT::$HAXEPATH\lib" + + - name: Print Haxe version + shell: pwsh + run: haxe -version + + - name: "Make Python 3 be available as python3 in the cmdline" + shell: pwsh + run: | + Set-PSDebug -Trace 1 + $pypath = python -c "import sys; print(sys.executable)" + $py3path = $pypath.replace("python.exe","python3.exe") + cmd /c mklink $py3path $pypath + python3 -V + + - name: Install hererocks + if: matrix.target == 'lua' + shell: cmd + run: | + pip install hererocks + hererocks lua53 -l5.3 -rlatest + call lua53/bin/activate + + - name: Setup haxelib + shell: pwsh + run: | + mkdir "$env:HAXELIB_ROOT" + haxelib setup "$env:HAXELIB_ROOT" + + - name: Test + shell: pwsh + run: haxe RunCi.hxml + working-directory: ${{github.workspace}}/tests + + + windows-test: + needs: windows-build + runs-on: windows-latest + env: + ACTIONS_ALLOW_UNSECURE_COMMANDS: true + PLATFORM: windows + TEST: ${{matrix.target}} + HXCPP_COMPILE_CACHE: ~/hxcache + ARCH: 32 + strategy: + fail-fast: false + matrix: + # TODO jvm: https://github.com/HaxeFoundation/haxe/issues/8601 + # TODO enable lua after https://github.com/HaxeFoundation/haxe/issues/5024 + target: [macro, js, hl, cpp, java, cs, php, python, neko] + steps: + - uses: actions/checkout@main + with: + submodules: recursive + - uses: actions/download-artifact@v1 + with: + name: win${{env.ARCH}}Binaries + + - name: Install Neko using snapshot from S3 (Unix) + if: ${{ !startsWith(env.PLATFORM, 'windows') }} + run: | + set -ex + + curl -sSL https://build.haxe.org/builds/neko/$PLATFORM/neko_latest.tar.gz -o $RUNNER_TEMP/neko_latest.tar.gz + tar -xf $RUNNER_TEMP/neko_latest.tar.gz -C $RUNNER_TEMP + NEKOPATH=`echo $RUNNER_TEMP/neko-*-*` + sudo mkdir -p /usr/local/bin + sudo mkdir -p /usr/local/lib/neko + sudo ln -s $NEKOPATH/{neko,nekoc,nekoml,nekotools} /usr/local/bin/ + sudo ln -s $NEKOPATH/libneko.* /usr/local/lib/ + sudo ln -s $NEKOPATH/*.ndll /usr/local/lib/neko/ + echo "NEKOPATH=$NEKOPATH" >> $GITHUB_ENV + + - name: Install Neko using snapshot from S3 (Windows) + if: ${{ startsWith(env.PLATFORM, 'windows') }} + shell: pwsh + run: | + Invoke-WebRequest https://build.haxe.org/builds/neko/$env:PLATFORM/neko_latest.zip -OutFile $env:RUNNER_TEMP/neko_latest.zip + Expand-Archive $env:RUNNER_TEMP/neko_latest.zip -DestinationPath $env:RUNNER_TEMP + $NEKOPATH = Get-ChildItem $env:RUNNER_TEMP/neko-*-* + echo "$NEKOPATH" >> $env:GITHUB_PATH + echo "NEKOPATH=$NEKOPATH" >> $env:GITHUB_ENV + + - name: Print Neko version + run: neko -version 2>&1 + + # - name: Quick test + # shell: pwsh + # run: | + # $DOWNLOADDIR="./win$($env:ARCH)Binaries" + # new-item -Name $DOWNLOADDIR -ItemType directory + # Invoke-WebRequest https://build.haxe.org/builds/haxe/$env:PLATFORM/haxe_latest.zip -OutFile $DOWNLOADDIR/haxe_bin.zip + + - name: Setup Haxe + shell: pwsh + run: | + $DOWNLOADDIR="./win$($env:ARCH)Binaries" + Expand-Archive $DOWNLOADDIR/*_bin.zip -DestinationPath $DOWNLOADDIR + Set-PSDebug -Trace 1 + $HAXEPATH = Get-ChildItem $DOWNLOADDIR/haxe_*_* -Directory + Write-Host "::add-path::$HAXEPATH" + Write-Host "::set-env name=HAXELIB_ROOT::$HAXEPATH\lib" + + - name: Print Haxe version + shell: pwsh + run: haxe -version + + - name: "Make Python 3 be available as python3 in the cmdline" + shell: pwsh + run: | + Set-PSDebug -Trace 1 + $pypath = python -c "import sys; print(sys.executable)" + $py3path = $pypath.replace("python.exe","python3.exe") + cmd /c mklink $py3path $pypath + python3 -V + + - name: Install hererocks + if: matrix.target == 'lua' + shell: cmd + run: | + pip install hererocks + hererocks lua53 -l5.3 -rlatest + call lua53/bin/activate + + - name: Setup haxelib + shell: pwsh + run: | + mkdir "$env:HAXELIB_ROOT" + haxelib setup "$env:HAXELIB_ROOT" + + - name: Test + shell: pwsh + run: haxe RunCi.hxml + working-directory: ${{github.workspace}}/tests + + + linux-test: + needs: linux-build + runs-on: ubuntu-latest + env: + PLATFORM: linux64 + TEST: ${{matrix.target}} + HXCPP_COMPILE_CACHE: ~/hxcache + strategy: + fail-fast: false + matrix: + target: [macro, js, hl, cpp, 'java,jvm', cs, php, python, lua, flash9, neko] + include: + - target: js + # SAUCE: 1 + # SAUCE_TUNNEL_ID: 'linux-test' + # SAUCE_BUILD: '${{env.GITHUB_RUN_NUMBER}}' # $(Build.BuildNumber) + - target: hl + APT_PACKAGES: cmake ninja-build libturbojpeg-dev + - target: cpp + APT_PACKAGES: gcc-multilib g++-multilib + - target: lua + APT_PACKAGES: ncurses-dev + - target: flash9 + APT_PACKAGES: libglib2.0 libfreetype6 xvfb + steps: + - uses: actions/checkout@main + with: + submodules: recursive + - uses: actions/download-artifact@v1 + with: + name: linuxBinaries + + - name: Install Neko using snapshot from S3 (Unix) + if: ${{ !startsWith(env.PLATFORM, 'windows') }} + run: | + set -ex + + curl -sSL https://build.haxe.org/builds/neko/$PLATFORM/neko_latest.tar.gz -o $RUNNER_TEMP/neko_latest.tar.gz + tar -xf $RUNNER_TEMP/neko_latest.tar.gz -C $RUNNER_TEMP + NEKOPATH=`echo $RUNNER_TEMP/neko-*-*` + sudo mkdir -p /usr/local/bin + sudo mkdir -p /usr/local/lib/neko + sudo ln -s $NEKOPATH/{neko,nekoc,nekoml,nekotools} /usr/local/bin/ + sudo ln -s $NEKOPATH/libneko.* /usr/local/lib/ + sudo ln -s $NEKOPATH/*.ndll /usr/local/lib/neko/ + echo "NEKOPATH=$NEKOPATH" >> $GITHUB_ENV + + - name: Install Neko using snapshot from S3 (Windows) + if: ${{ startsWith(env.PLATFORM, 'windows') }} + shell: pwsh + run: | + Invoke-WebRequest https://build.haxe.org/builds/neko/$env:PLATFORM/neko_latest.zip -OutFile $env:RUNNER_TEMP/neko_latest.zip + Expand-Archive $env:RUNNER_TEMP/neko_latest.zip -DestinationPath $env:RUNNER_TEMP + $NEKOPATH = Get-ChildItem $env:RUNNER_TEMP/neko-*-* + echo "$NEKOPATH" >> $env:GITHUB_PATH + echo "NEKOPATH=$NEKOPATH" >> $env:GITHUB_ENV + + - name: Print Neko version + run: neko -version 2>&1 + + - name: Setup Haxe + run: | + # mkdir ./linuxBinaries + # curl -sSL https://build.haxe.org/builds/haxe/linux64/haxe_latest.tar.gz -o ./linuxBinaries/haxe_bin.tar.gz + + sudo apt install -qqy libmbedtls-dev + + set -ex + tar -xf linuxBinaries/*_bin.tar.gz -C linuxBinaries --strip-components=1 + sudo mkdir -p /usr/local/bin/ + sudo mkdir -p /usr/local/share/haxe/ + sudo ln -s `pwd`/linuxBinaries/haxe /usr/local/bin/haxe + sudo ln -s `pwd`/linuxBinaries/haxelib /usr/local/bin/haxelib + sudo ln -s `pwd`/linuxBinaries/std /usr/local/share/haxe/std + + - name: Print Haxe version + run: haxe -version + + - name: Setup haxelib + run: | + set -ex + mkdir ~/haxelib + haxelib setup ~/haxelib + + - name: Install apt packages + if: matrix.APT_PACKAGES + run: | + set -ex + sudo apt update -qqy + sudo apt install -qqy ${{matrix.APT_PACKAGES}} + + - name: Flash setup + if: matrix.target == 'flash9' + run: export DISPLAY=:99.0 + + - name: Test + if: success() && !(matrix.SAUCE && matrix.SAUCE_ACCESS_KEY) + run: haxe RunCi.hxml + working-directory: ${{github.workspace}}/tests + + - name: Test (with SauceLabs) + if: matrix.target == 'js' && success() && matrix.SAUCE && matrix.SAUCE_ACCESS_KEY + run: haxe RunCi.hxml + working-directory: ${{github.workspace}}/tests + env: + SAUCE_ACCESS_KEY: matrix.SAUCE_ACCESS_KEY + + + mac-test: + needs: mac-build + runs-on: macos-latest + env: + PLATFORM: mac + TEST: ${{matrix.target}} + HXCPP_COMPILE_CACHE: ~/hxcache + strategy: + fail-fast: false + matrix: + target: [macro, js, hl, cpp, 'java,jvm', cs, php, python, lua, flash9, neko] + include: + - target: hl + BREW_PACKAGES: ninja + steps: + - uses: actions/checkout@main + with: + submodules: recursive + - uses: actions/download-artifact@v1 + with: + name: macBinaries + + - name: Install Neko using snapshot from S3 (Unix) + if: ${{ !startsWith(env.PLATFORM, 'windows') }} + run: | + set -ex + + curl -sSL https://build.haxe.org/builds/neko/$PLATFORM/neko_latest.tar.gz -o $RUNNER_TEMP/neko_latest.tar.gz + tar -xf $RUNNER_TEMP/neko_latest.tar.gz -C $RUNNER_TEMP + NEKOPATH=`echo $RUNNER_TEMP/neko-*-*` + sudo mkdir -p /usr/local/bin + sudo mkdir -p /usr/local/lib/neko + sudo ln -s $NEKOPATH/{neko,nekoc,nekoml,nekotools} /usr/local/bin/ + sudo ln -s $NEKOPATH/libneko.* /usr/local/lib/ + sudo ln -s $NEKOPATH/*.ndll /usr/local/lib/neko/ + echo "NEKOPATH=$NEKOPATH" >> $GITHUB_ENV + + - name: Install Neko using snapshot from S3 (Windows) + if: ${{ startsWith(env.PLATFORM, 'windows') }} + shell: pwsh + run: | + Invoke-WebRequest https://build.haxe.org/builds/neko/$env:PLATFORM/neko_latest.zip -OutFile $env:RUNNER_TEMP/neko_latest.zip + Expand-Archive $env:RUNNER_TEMP/neko_latest.zip -DestinationPath $env:RUNNER_TEMP + $NEKOPATH = Get-ChildItem $env:RUNNER_TEMP/neko-*-* + echo "$NEKOPATH" >> $env:GITHUB_PATH + echo "NEKOPATH=$NEKOPATH" >> $env:GITHUB_ENV + + - name: Print Neko version + run: neko -version 2>&1 + + - name: Setup Haxe + run: | + # mkdir ./macBinaries + # curl -sSL https://build.haxe.org/builds/haxe/mac/haxe_latest.tar.gz -o ./macBinaries/haxe_bin.tar.gz + + set -ex + tar -xf macBinaries/*_bin.tar.gz -C macBinaries --strip-components=1 + sudo mkdir -p /usr/local/bin/ + sudo mkdir -p /usr/local/share/haxe/ + sudo ln -s `pwd`/macBinaries/haxe /usr/local/bin/haxe + sudo ln -s `pwd`/macBinaries/haxelib /usr/local/bin/haxelib + sudo ln -s `pwd`/macBinaries/std /usr/local/share/haxe/std + + - name: Print Haxe version + run: haxe -version + + - name: Setup haxelib + run: | + set -ex + mkdir ~/haxelib + haxelib setup ~/haxelib + + - name: Install homebrew packages + if: matrix.BREW_PACKAGES + run: brew install ${{matrix.BREW_PACKAGES}} + + - name: Test + run: | + # disable invalid Unicode filenames on APFS + echo "" > sys/compile-fs.hxml + haxe RunCi.hxml + working-directory: ${{github.workspace}}/tests + + + deploy: + if: github.event_name != 'pull_request' + needs: [linux-test, mac-test, windows-test, windows64-test] + runs-on: ubuntu-latest + steps: + # this is only needed for to get `COMMIT_DATE`... + # maybe https://github.community/t/expose-commit-timestamp-in-the-github-context-data/16460/3 + # would be faster + - name: Checkout the repository + uses: actions/checkout@main + + - name: Download build artifacts + uses: actions/download-artifact@v2 + + - name: Install awscli + run: | + set -ex + sudo apt-get update -qqy + sudo apt-get install -qqy awscli + + # https://stackoverflow.com/questions/58033366/how-to-get-current-branch-within-github-actions + - name: Extract branch name + id: extract_branch + shell: bash + run: echo "##[set-output name=branch;]$(echo ${GITHUB_REF#refs/heads/})" + + - name: Upload binaries + shell: bash + env: + AWS_ACCESS_KEY_ID: ${{ secrets.HXBUILDS_AWS_ACCESS_KEY_ID }} + AWS_SECRET_ACCESS_KEY: ${{ secrets.HXBUILDS_AWS_SECRET_ACCESS_KEY }} + HXBUILDS_S3ADDR: ${{ secrets.HXBUILDS_S3ADDR }} + run: | + set -ex + COMMIT_HASH_SHORT=${GITHUB_SHA:0:7} + COMMIT_DATE=`TZ=UTC git show --quiet --date='format-local:%Y-%m-%d' --format="%cd"` + FILE_NAME=haxe_${COMMIT_DATE}_${{ steps.extract_branch.outputs.branch }}_${COMMIT_HASH_SHORT} + aws s3 cp linuxBinaries/*_bin.tar.gz ${HXBUILDS_S3ADDR}/haxe/linux64/${FILE_NAME}.tar.gz + aws s3 cp macBinaries/*_bin.tar.gz ${HXBUILDS_S3ADDR}/haxe/mac/${FILE_NAME}.tar.gz + aws s3 cp macBinaries/*_installer.tar.gz ${HXBUILDS_S3ADDR}/haxe/mac-installer/${FILE_NAME}.tar.gz + aws s3 cp win64Binaries/*_bin.zip ${HXBUILDS_S3ADDR}/haxe/windows64/${FILE_NAME}.zip + aws s3 cp win64Binaries/*_installer.zip ${HXBUILDS_S3ADDR}/haxe/windows64-installer/${FILE_NAME}.zip + aws s3 cp win64Binaries/*.nupkg ${HXBUILDS_S3ADDR}/haxe/windows64-choco/ + aws s3 cp win32Binaries/*_bin.zip ${HXBUILDS_S3ADDR}/haxe/windows/${FILE_NAME}.zip + aws s3 cp win32Binaries/*_installer.zip ${HXBUILDS_S3ADDR}/haxe/windows-installer/${FILE_NAME}.zip + aws s3 cp win32Binaries/*.nupkg ${HXBUILDS_S3ADDR}/haxe/windows-choco/ + + - name: Update "latest" + if: github.ref == 'refs/heads/development' + shell: bash + env: + AWS_ACCESS_KEY_ID: ${{ secrets.HXBUILDS_AWS_ACCESS_KEY_ID }} + AWS_SECRET_ACCESS_KEY: ${{ secrets.HXBUILDS_AWS_SECRET_ACCESS_KEY }} + HXBUILDS_S3ADDR: ${{ secrets.HXBUILDS_S3ADDR }} + run: | + set -ex + aws s3 cp linuxBinaries/*_bin.tar.gz ${HXBUILDS_S3ADDR}/haxe/linux64/haxe_latest.tar.gz + aws s3 cp macBinaries/*_bin.tar.gz ${HXBUILDS_S3ADDR}/haxe/mac/haxe_latest.tar.gz + aws s3 cp macBinaries/*_installer.tar.gz ${HXBUILDS_S3ADDR}/haxe/mac-installer/haxe_latest.tar.gz + aws s3 cp win64Binaries/*_bin.zip ${HXBUILDS_S3ADDR}/haxe/windows64/haxe_latest.zip + aws s3 cp win64Binaries/*_installer.zip ${HXBUILDS_S3ADDR}/haxe/windows64-installer/haxe_latest.zip + aws s3 cp win32Binaries/*_bin.zip ${HXBUILDS_S3ADDR}/haxe/windows/haxe_latest.zip + aws s3 cp win32Binaries/*_installer.zip ${HXBUILDS_S3ADDR}/haxe/windows-installer/haxe_latest.zip + + # Chocolatey packages have to be named with version number, + # so let's use web redirection to keep the original file name. + [[ "$HXBUILDS_S3ADDR" =~ s3://([^/]+)(.*) ]] && HXBUILDS_S3BUCKET="${BASH_REMATCH[1]}" && HXBUILDS_S3PATH="${BASH_REMATCH[2]}" + [[ `echo win64Binaries/*.nupkg` =~ win64Binaries/(.+) ]] && FILE_NAME="${BASH_REMATCH[1]}" + aws s3 cp ${HXBUILDS_S3ADDR}/haxe/windows64-choco/${FILE_NAME} ${HXBUILDS_S3ADDR}/haxe/windows64-choco/haxe_latest.nupkg --acl public-read --website-redirect "${HXBUILDS_S3PATH}/haxe/windows64-choco/${FILE_NAME}" + [[ `echo win32Binaries/*.nupkg` =~ win32Binaries/(.+) ]] && FILE_NAME="${BASH_REMATCH[1]}" + aws s3 cp ${HXBUILDS_S3ADDR}/haxe/windows-choco/${FILE_NAME} ${HXBUILDS_S3ADDR}/haxe/windows-choco/haxe_latest.nupkg --acl public-read --website-redirect "${HXBUILDS_S3PATH}/haxe/windows-choco/${FILE_NAME}" + + deploy_apidoc: + if: github.event_name != 'pull_request' # TODO: also only when `GHP_REMOTE` is present + needs: [linux-test, mac-test, windows-test, windows64-test] + runs-on: ubuntu-latest + steps: + - name: Download Haxe + uses: actions/download-artifact@v2 + with: + name: linuxBinaries + path: linuxBinaries + + - name: Setup Haxe + run: | + set -ex + tar -xf linuxBinaries/*_bin.tar.gz -C linuxBinaries --strip-components=1 + sudo mkdir -p /usr/local/bin/ + sudo mkdir -p /usr/local/share/haxe/ + sudo ln -s `pwd`/linuxBinaries/haxe /usr/local/bin/haxe + sudo ln -s `pwd`/linuxBinaries/haxelib /usr/local/bin/haxelib + sudo ln -s `pwd`/linuxBinaries/std /usr/local/share/haxe/std + + - name: Download xmldoc artifact + uses: actions/download-artifact@v2 + with: + name: xmldoc + path: xmldoc + + - name: Deploy to api.haxe.org + env: + GHP_EMAIL: haxe-ci@onthewings.net + GHP_USERNAME: Haxe CI Bot + GHP_REMOTE: ${{ secrets.GHP_REMOTE }} + run: | + set -ex + LOCAL="`pwd`/extra/api.haxe.org" + git clone "${GHP_REMOTE}" "${LOCAL}" + haxe --cwd "${LOCAL}" --run ImportXml "`pwd`/xmldoc" diff --git a/.vscode/schemas/define.schema.json b/.vscode/schemas/define.schema.json index 1d902d1a..e7fc6f96 100644 --- a/.vscode/schemas/define.schema.json +++ b/.vscode/schemas/define.schema.json @@ -57,6 +57,10 @@ "type": "string", "format": "uri" } + }, + "reserved": { + "type": "boolean", + "markdownDescription": "Reserved defines may not be defined from the command line." } }, "required": [ diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index 96dce683..6f4c8a0c 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -2,7 +2,7 @@ - Check if you actually suspect that there's an issue in the Haxe code. If you find yourself writing "How do I..." you may want to consider a different communication channel. Refer to https://haxe.org/community/community-support.html for more information. - Reduce your code to a minimal example (see http://sscce.org/). In particular avoid library dependencies: If you cannot reproduce your issue without using a specific library, it might not be a Haxe issue to begin with. -- Check if your problems are already resolved in the Haxe development version (for builds see http://builds.haxe.org/). +- Check if your problems are already resolved in the Haxe development version (for builds see http://build.haxe.org/). - Most targets produce readable code. If you suspect the generated code to be wrong, try checking the output. Note that you can add `-D dump=pretty` to your compilation parameters and find the code which is passed to the generators in a `dump` subdirectory. ## Is this the right repository to report the issue? diff --git a/Makefile b/Makefile index 29430282..7f5268e9 100644 --- a/Makefile +++ b/Makefile @@ -46,7 +46,7 @@ endif ADD_REVISION?=0 -BRANCH=$(shell echo $$APPVEYOR_REPO_NAME | grep -q /haxe && echo $$APPVEYOR_REPO_BRANCH || echo $$TRAVIS_REPO_SLUG | grep -q /haxe && echo $$TRAVIS_BRANCH || git rev-parse --abbrev-ref HEAD) +BRANCH=$(shell git rev-parse --abbrev-ref HEAD) COMMIT_SHA=$(shell git rev-parse --short HEAD) COMMIT_DATE=$(shell \ if [ "$$(uname)" = "Darwin" ]; then \ diff --git a/README.md b/README.md index 675f7047..b7ee7589 100644 --- a/README.md +++ b/README.md @@ -3,7 +3,7 @@

- Azure Pipelines Build Status + GitHub Build Status SauceLabs Test Status Gitter Discord diff --git a/azure-pipelines.yml b/azure-pipelines.yml deleted file mode 100644 index 2c47c025..00000000 --- a/azure-pipelines.yml +++ /dev/null @@ -1,318 +0,0 @@ -variables: - - group: variables-haxe - - name: AZURE_PIPELINES_REPO_URL - value: $(Build.Repository.Uri) - - name: AZURE_PIPELINES_BRANCH - value: $(Build.SourceBranchName) - -trigger: - branches: - include: - - '*' - tags: - include: - - '*' - -stages: - - stage: StageTest - jobs: - - template: extra/azure-pipelines/build-linux.yml - parameters: - name: BuildLinux - - - template: extra/azure-pipelines/build-mac.yml - parameters: - name: BuildMac - - - template: extra/azure-pipelines/build-windows.yml - parameters: - name: BuildWin64 - arch: '64' - - - template: extra/azure-pipelines/build-windows.yml - parameters: - name: BuildWin32 - arch: '32' - - - job: TestLinux - dependsOn: BuildLinux - pool: - vmImage: 'ubuntu-16.04' - strategy: - matrix: - macro: - TEST: macro - neko: - TEST: neko - hl: - TEST: hl - APT_PACKAGES: cmake ninja-build - cpp: - TEST: cpp - HXCPP_COMPILE_CACHE: ~/hxcache - APT_PACKAGES: gcc-multilib g++-multilib - java: - TEST: java,jvm - cs: - TEST: cs - js: - TEST: js - SAUCE: 1 - SAUCE_TUNNEL_ID: $(Agent.JobName) - SAUCE_BUILD: $(Build.BuildNumber) - php: - TEST: php - flash: - TEST: flash9 - APT_PACKAGES: libglib2.0 libfreetype6 xvfb - DISPLAY: ':99.0' - AUDIODEV: 'null' - python: - TEST: python - lua: - TEST: lua - APT_PACKAGES: ncurses-dev - steps: - - checkout: self - fetchDepth: 20 - - template: extra/azure-pipelines/install-neko-snapshot.yaml - parameters: - platform: linux64 - - task: DownloadPipelineArtifact@0 - inputs: - artifactName: 'linuxBinaries' - targetPath: linuxBinaries - - script: | - set -ex - tar -xf linuxBinaries/*_bin.tar.gz -C linuxBinaries --strip-components=1 - sudo mkdir -p /usr/local/bin/ - sudo mkdir -p /usr/local/share/haxe/ - sudo ln -s `pwd`/linuxBinaries/haxe /usr/local/bin/haxe - sudo ln -s `pwd`/linuxBinaries/haxelib /usr/local/bin/haxelib - sudo ln -s `pwd`/linuxBinaries/std /usr/local/share/haxe/std - displayName: Setup Haxe - - script: haxe -version - displayName: Print Haxe version - - script: | - set -ex - mkdir ~/haxelib - haxelib setup ~/haxelib - displayName: Setup haxelib - - script: | - set -ex - sudo apt update -qqy - sudo apt install -qqy $APT_PACKAGES - condition: and(succeeded(), variables['APT_PACKAGES']) - displayName: Install apt packages - - script: haxe RunCi.hxml - condition: and(succeeded(), not(and(variables['SAUCE'], variables['SAUCE_ACCESS_KEY']))) - workingDirectory: $(Build.SourcesDirectory)/tests - displayName: Test - - script: haxe RunCi.hxml - condition: and(succeeded(), variables['SAUCE'], variables['SAUCE_ACCESS_KEY']) - workingDirectory: $(Build.SourcesDirectory)/tests - env: - SAUCE_ACCESS_KEY: $(SAUCE_ACCESS_KEY) - displayName: Test (with SauceLabs) - - - job: TestMac - dependsOn: BuildMac - pool: - vmImage: 'macOS-10.14' - strategy: - matrix: - macro: - TEST: macro - neko: - TEST: neko - hl: - TEST: hl - BREW_PACKAGES: ninja - cpp: - TEST: cpp - HXCPP_COMPILE_CACHE: ~/hxcache - java: - TEST: java,jvm - cs: - TEST: cs - js: - TEST: js - php: - TEST: php - flash: - TEST: flash9 - python: - TEST: python - lua: - TEST: lua - steps: - - checkout: self - fetchDepth: 20 - - template: extra/azure-pipelines/install-neko-snapshot.yaml - parameters: - platform: mac - - task: DownloadPipelineArtifact@0 - inputs: - artifactName: 'macBinaries' - targetPath: macBinaries - - script: | - set -ex - tar -xf macBinaries/*_bin.tar.gz -C macBinaries --strip-components=1 - sudo mkdir -p /usr/local/bin/ - sudo mkdir -p /usr/local/share/haxe/ - sudo ln -s `pwd`/macBinaries/haxe /usr/local/bin/haxe - sudo ln -s `pwd`/macBinaries/haxelib /usr/local/bin/haxelib - sudo ln -s `pwd`/macBinaries/std /usr/local/share/haxe/std - displayName: Setup Haxe - - script: haxe -version - displayName: Print Haxe version - - script: | - set -ex - mkdir ~/haxelib - haxelib setup ~/haxelib - displayName: Setup haxelib - - script: brew install $BREW_PACKAGES - condition: and(succeeded(), variables['BREW_PACKAGES']) - displayName: Install homebrew packages - - script: | - # disable invalid Unicode filenames on APFS - echo "" > sys/compile-fs.hxml - haxe RunCi.hxml - workingDirectory: $(Build.SourcesDirectory)/tests - displayName: Test - - - template: extra/azure-pipelines/test-windows.yml - parameters: - name: TestWin64 - arch: '64' - - - template: extra/azure-pipelines/test-windows.yml - parameters: - name: TestWin32 - arch: '32' - - - stage: StageDeploy - condition: and(succeeded(), not(variables['System.PullRequest.PullRequestId'])) - jobs: - - job: S3 - condition: and(succeeded(), variables['HXBUILDS_AWS_ACCESS_KEY_ID'], variables['HXBUILDS_S3ADDR']) - pool: - vmImage: 'ubuntu-16.04' - steps: - - checkout: self - fetchDepth: 20 - - task: DownloadPipelineArtifact@0 - inputs: - artifactName: 'linuxBinaries' - targetPath: linuxBinaries - displayName: Download linuxBinaries - - task: DownloadPipelineArtifact@0 - inputs: - artifactName: 'macBinaries' - targetPath: macBinaries - displayName: Download macBinaries - - task: DownloadPipelineArtifact@0 - inputs: - artifactName: 'win64Binaries' - targetPath: win64Binaries - displayName: Download win64Binaries - - task: DownloadPipelineArtifact@0 - inputs: - artifactName: 'win32Binaries' - targetPath: win32Binaries - displayName: Download win32Binaries - - template: extra/azure-pipelines/install-neko-snapshot.yaml - parameters: - platform: linux64 - - script: | - set -ex - tar -xf linuxBinaries/*_bin.tar.gz -C linuxBinaries --strip-components=1 - sudo mkdir -p /usr/local/bin/ - sudo mkdir -p /usr/local/share/haxe/ - sudo ln -s `pwd`/linuxBinaries/haxe /usr/local/bin/haxe - sudo ln -s `pwd`/linuxBinaries/haxelib /usr/local/bin/haxelib - sudo ln -s `pwd`/linuxBinaries/std /usr/local/share/haxe/std - displayName: Setup Haxe - - script: | - set -ex - sudo apt-get update -qqy - sudo apt-get install -qqy awscli - displayName: "Install awscli" - - script: | - set -ex - COMMIT_HASH=`git rev-parse HEAD` - COMMIT_HASH_SHORT=${COMMIT_HASH:0:7} - COMMIT_DATE=`TZ=UTC git show --quiet --date='format-local:%Y-%m-%d' --format="%cd"` - FILE_NAME=haxe_${COMMIT_DATE}_$(Build.SourceBranchName)_${COMMIT_HASH_SHORT} - aws s3 cp linuxBinaries/*_bin.tar.gz $(HXBUILDS_S3ADDR)/haxe/linux64/${FILE_NAME}.tar.gz - aws s3 cp macBinaries/*_bin.tar.gz $(HXBUILDS_S3ADDR)/haxe/mac/${FILE_NAME}.tar.gz - aws s3 cp macBinaries/*_installer.tar.gz $(HXBUILDS_S3ADDR)/haxe/mac-installer/${FILE_NAME}.tar.gz - aws s3 cp win64Binaries/*_bin.zip $(HXBUILDS_S3ADDR)/haxe/windows64/${FILE_NAME}.zip - aws s3 cp win64Binaries/*_installer.zip $(HXBUILDS_S3ADDR)/haxe/windows64-installer/${FILE_NAME}.zip - aws s3 cp win64Binaries/*.nupkg $(HXBUILDS_S3ADDR)/haxe/windows64-choco/ - aws s3 cp win32Binaries/*_bin.zip $(HXBUILDS_S3ADDR)/haxe/windows/${FILE_NAME}.zip - aws s3 cp win32Binaries/*_installer.zip $(HXBUILDS_S3ADDR)/haxe/windows-installer/${FILE_NAME}.zip - aws s3 cp win32Binaries/*.nupkg $(HXBUILDS_S3ADDR)/haxe/windows-choco/ - env: - AWS_ACCESS_KEY_ID: $(HXBUILDS_AWS_ACCESS_KEY_ID) - AWS_SECRET_ACCESS_KEY: $(HXBUILDS_AWS_SECRET_ACCESS_KEY) - displayName: Upload binaries - - script: | - set -ex - aws s3 cp linuxBinaries/*_bin.tar.gz $(HXBUILDS_S3ADDR)/haxe/linux64/haxe_latest.tar.gz - aws s3 cp macBinaries/*_bin.tar.gz $(HXBUILDS_S3ADDR)/haxe/mac/haxe_latest.tar.gz - aws s3 cp macBinaries/*_installer.tar.gz $(HXBUILDS_S3ADDR)/haxe/mac-installer/haxe_latest.tar.gz - aws s3 cp win64Binaries/*_bin.zip $(HXBUILDS_S3ADDR)/haxe/windows64/haxe_latest.zip - aws s3 cp win64Binaries/*_installer.zip $(HXBUILDS_S3ADDR)/haxe/windows64-installer/haxe_latest.zip - aws s3 cp win32Binaries/*_bin.zip $(HXBUILDS_S3ADDR)/haxe/windows/haxe_latest.zip - aws s3 cp win32Binaries/*_installer.zip $(HXBUILDS_S3ADDR)/haxe/windows-installer/haxe_latest.zip - - # Chocolatey packages have to be named with version number, - # so let's use web redirection to keep the original file name. - [[ "$HXBUILDS_S3ADDR" =~ s3://([^/]+)(.*) ]] && HXBUILDS_S3BUCKET="${BASH_REMATCH[1]}" && HXBUILDS_S3PATH="${BASH_REMATCH[2]}" - [[ `echo win64Binaries/*.nupkg` =~ win64Binaries/(.+) ]] && FILE_NAME="${BASH_REMATCH[1]}" - aws s3 cp $(HXBUILDS_S3ADDR)/haxe/windows64-choco/${FILE_NAME} $(HXBUILDS_S3ADDR)/haxe/windows64-choco/haxe_latest.nupkg --acl public-read --website-redirect "${HXBUILDS_S3PATH}/haxe/windows64-choco/${FILE_NAME}" - [[ `echo win32Binaries/*.nupkg` =~ win32Binaries/(.+) ]] && FILE_NAME="${BASH_REMATCH[1]}" - aws s3 cp $(HXBUILDS_S3ADDR)/haxe/windows-choco/${FILE_NAME} $(HXBUILDS_S3ADDR)/haxe/windows-choco/haxe_latest.nupkg --acl public-read --website-redirect "${HXBUILDS_S3PATH}/haxe/windows-choco/${FILE_NAME}" - env: - AWS_ACCESS_KEY_ID: $(HXBUILDS_AWS_ACCESS_KEY_ID) - AWS_SECRET_ACCESS_KEY: $(HXBUILDS_AWS_SECRET_ACCESS_KEY) - condition: and(succeeded(), eq(variables['Build.SourceBranchName'], 'development')) - displayName: Update "latest" - - - job: ApiHaxeOrg - condition: and(succeeded(), variables['GHP_USERNAME'], variables['GHP_EMAIL']) - pool: - vmImage: 'ubuntu-16.04' - steps: - - checkout: none - - template: extra/azure-pipelines/install-neko-snapshot.yaml - parameters: - platform: linux64 - - task: DownloadPipelineArtifact@0 - inputs: - artifactName: 'linuxBinaries' - targetPath: linuxBinaries - displayName: Download linuxBinaries - - script: | - set -ex - tar -xf linuxBinaries/*_bin.tar.gz -C linuxBinaries --strip-components=1 - sudo mkdir -p /usr/local/bin/ - sudo mkdir -p /usr/local/share/haxe/ - sudo ln -s `pwd`/linuxBinaries/haxe /usr/local/bin/haxe - sudo ln -s `pwd`/linuxBinaries/haxelib /usr/local/bin/haxelib - sudo ln -s `pwd`/linuxBinaries/std /usr/local/share/haxe/std - displayName: Setup Haxe - - task: DownloadPipelineArtifact@0 - inputs: - artifactName: 'xmldoc' - targetPath: xmldoc - displayName: Download xmldoc - - script: | - set -ex - LOCAL="`pwd`/extra/api.haxe.org" - git clone "${GHP_REMOTE}" "${LOCAL}" - haxe --cwd "${LOCAL}" --run ImportXml "`pwd`/xmldoc" - env: - GHP_REMOTE: $(GHP_REMOTE) - displayName: Deploy to api.haxe.org \ No newline at end of file diff --git a/extra/CHANGES.txt b/extra/CHANGES.txt index 93ef2727..d90a10ef 100644 --- a/extra/CHANGES.txt +++ b/extra/CHANGES.txt @@ -1,3 +1,80 @@ +2021-02-09 4.2.0: + + New features: + + all : implemented "classic" abstract classes and functions (see [haxe-evolution#69](https://github.com/HaxeFoundation/haxe-evolution/pull/69)) (#9716) + all : module-level static declarations (#8460) + all : implemented rest arguments (variadic functions) for all targets with `haxe.Rest` type (#9961) + all : per-thread event loops `sys.thread.Thread.events` (#9868) + all : added `@:inheritDoc` meta to inherit documentation for a type or field from another type or field (#9817) + all : support method overloading for extern methods on all targets (#9793) + all : constructors forwarding for abstracts with `@:forward.new` (#9735) + all : added `EIs` constructor to `haxe.macro.Expr` (#9689) + all : added variance forwarding with `@:forward.variance` (#9741) + all : treat `Any` as `Dynamic` in variance unification (#6649) + all : added some common exception types to `haxe.exceptions` package + all : support metadata in var declaration syntax (#9618) + all : added `StringTools.unsafeCharAt` (#9467) + eval : added libuv bindings under `eval.luv` package (#9903) + eval : added bindings to native `Int64` and `UInt64` implementations under `eval.integers` package (#9903) + cs : UDP socket implementation (#8498) + cs : added `cs.Syntax` module (#10051) + jvm : added `-D jvm.dynamic-level` to control the amount of dynamic support code being generated. 0 = none, 1 = field read/write optimization (default), 2 = compile-time method closures + java,jvm : support `--java-lib ` (#9551) + python : threading API implementation (#9754) + + General improvements: + + all : `expr is SomeType` doesn't require parentheses anymore (#9672) + all : increased priority of @:using extensions (#9681) + all : allowed usage of static extensions with super (#10062) + all : allow @:noDoc on fields too (#9893) + all : made `Map` abstract transitive (#9877) + all : support `@:native` on enum constructors (#9806) + all : support `@:using` on typedefs (#9749) + all : changed multiline errors format to use "..." as a prefix for subsequent lines (#9651) + all : improved type inference with constrained monomorphs (#9549) + all : print no-argument function types as `()->...` instead of `Void->...` (#8148) + all : allow `function` as package name + all : improved object inlining (#9599) + display : narrow range for hover on parametrized types (#8073) + cs : added .NET 5.0 support (#10043) + cpp : support native constructors on extern classes (#9516) + php: `php.Syntax.customArrayDecl` (#9113) + php : added externs for various php functions and classes + php : optimized anonymous objects instantiation (#7916) + hl : skip compilation if no module has been changed (#9922) + lua : use hx-lua-simdjson for Lua json parsing (#9885) + jvm : less CPU consuming `sys.thread.Lock` implementation + + Bugfixes: + + all : fixed Template.resolve when current context is not an object (#9372) + all : `get` and `set` functions of `haxe.io.Float64Array` actually use 64-bit floats now (#9972) + all : treat empty blocks `{}` as object declarations in array comprehension (fixes #9971) + all : `haxe.format.JsonParser`: preserve Float-typed values when they are written as such in JSON (ie. "5.0" or "0.0") (#9844) + all : fixed priority of forwarded static extensions (#9680) + all : fixed some inconsistency in variance unification for abstracts (#9743) + display : fixed completion with platform-specific files (#9423) + cpp : fixed conversion of `cpp.Int64` to/from `haxe.Int64` (#10101) + cpp : fixed extending extern classes with `@:nativeGen` classes (#9431) + php : fixed generation with subdirectories in `-D php-front=subdir/index.php` (#10037) + php : fixed local vars with the same names as super global vars (#9924) + eval : allow full range of 32bit integers in `Std.random` (#9974) + js : fixed `haxe.CallStack.exceptionStack` (#9968) + js : fixed compatibility issue with closure compiler upon unused `catch` vars (#9617) + lua : fixed anonymous object printing issue with null fields on tables + hl : drop data of terminated threads (#9875) + macro : fixed `haxe.macro.Context.storeTypedExpr` for enum constructs (#9828) + macro : emit a deprecation warning upon a macro call instead of upon a macro function declaration (#9425) + macro : fixed uncatchable error from `haxe.macro.Context.getType` (#9449) + jvm : fixed `Type.resolveEnum` for enums in the root package (#9809) + jvm : fixed `Type.resolveEnumName` for enums in the root package (#9759) + cs : fixed cs.Lib.rethrow (#9738) + nullsafety : respect `@:nullSafety(Off)` on var declarations: `var @:nullSafety(Off) v` + nullsafety : respect `@:nullSafety(Off)` in closures in constructors (#9643) + nullsafety : fixed error "Type not found : haxe.macro._Compiler.NullSafetyMode_Impl_" (#9483) + 2020-12-31 4.1.5: General improvements: @@ -80,7 +157,7 @@ js : fixed name collisions for catch variables to avoid closure compiler errors (#9617) nullsafety : fixed various scenarios of `if..else` branching (#9474) -2020-22-05 4.1.1 +2020-05-22 4.1.1 New features: diff --git a/extra/ImportAll.hx b/extra/ImportAll.hx index 22e3f49a..c445e3ed 100644 --- a/extra/ImportAll.hx +++ b/extra/ImportAll.hx @@ -73,7 +73,7 @@ class ImportAll { case "tools", "build-tool", "jar-tool": return; } for( p in Context.getClassPath() ) { - if( p == "/" ) + if( p == "/" || p == "" ) continue; // skip if we have a classpath to haxe if( pack.length == 0 && sys.FileSystem.exists(p+"std") ) diff --git a/extra/all.hxml b/extra/all.hxml index 1fbb6e39..9b8b7804 100644 --- a/extra/all.hxml +++ b/extra/all.hxml @@ -33,8 +33,7 @@ -xml java.xml --next --java all_jvm --D jvm +--jvm all_jvm -xml jvm.xml --next diff --git a/extra/azure-pipelines/build-linux.yml b/extra/azure-pipelines/build-linux.yml deleted file mode 100644 index aa60631f..00000000 --- a/extra/azure-pipelines/build-linux.yml +++ /dev/null @@ -1,61 +0,0 @@ -parameters: - name: 'BuildLinux' - vmImage: 'ubuntu-16.04' - -jobs: - - job: ${{ parameters.name }} - pool: - vmImage: ${{ parameters.vmImage }} - variables: - OPAMYES: 1 - ${{ if not(startsWith(variables['Build.SourceBranch'], 'refs/tags/')) }}: - ADD_REVISION: 1 - steps: - - checkout: self - submodules: recursive - - script: | - set -ex - sudo add-apt-repository ppa:avsm/ppa -y # provides OPAM 2 - sudo add-apt-repository ppa:haxe/ocaml -y # provides newer version of mbedtls - sudo apt-get update -qqy - sudo apt-get install -qqy ocaml-nox camlp5 opam libpcre3-dev zlib1g-dev libgtk2.0-dev libmbedtls-dev ninja-build - displayName: Install dependencies - - template: install-neko-snapshot.yaml - parameters: - platform: linux64 - - script: | - set -ex - opam init - opam update - opam pin add haxe . --no-action - opam install haxe --deps-only - opam list - ocamlopt -v - displayName: Install OCaml libraries - - script: | - set -ex - opam config exec -- make -s -j`nproc` STATICLINK=1 haxe - opam config exec -- make -s haxelib - make -s package_bin - ls -l out - ldd -v ./haxe - ldd -v ./haxelib - displayName: Build Haxe - - task: PublishPipelineArtifact@0 - inputs: - artifactName: 'linuxBinaries' - targetPath: out - - script: | - set -ex - make -s xmldoc - cat >extra/doc/info.json <&1') - & "$(CYG_ROOT)/bin/bash.exe" @('-lc', 'opam update --yes 2>&1') - & "$(CYG_ROOT)/bin/bash.exe" @('-lc', 'cd "$OLDPWD" && opam pin add haxe . --kind=path --no-action --yes 2>&1') - & "$(CYG_ROOT)/bin/bash.exe" @('-lc', 'opam install haxe --deps-only --yes 2>&1') - & "$(CYG_ROOT)/bin/bash.exe" @('-lc', 'opam list') - & "$(CYG_ROOT)/bin/bash.exe" @('-lc', 'ocamlopt -v') - displayName: Install OCaml and OCaml libraries - - powershell: Write-Host "##vso[task.prependpath]${env:CYG_ROOT}/usr/$(MINGW_ARCH)-w64-mingw32/sys-root/mingw/bin" - displayName: Expose mingw dll files - - powershell: | - Set-PSDebug -Trace 1 - & "$(CYG_ROOT)/bin/bash.exe" @('-lc', 'cd "$OLDPWD" && opam config exec -- make -s -f Makefile.win -j`nproc` haxe 2>&1') - & "$(CYG_ROOT)/bin/bash.exe" @('-lc', 'cd "$OLDPWD" && opam config exec -- make -s -f Makefile.win haxelib 2>&1') - & "$(CYG_ROOT)/bin/bash.exe" @('-lc', 'cd "$OLDPWD" && opam config exec -- make -f Makefile.win echo_package_files package_bin package_installer_win package_choco 2>&1') - dir out - & "$(CYG_ROOT)/bin/bash.exe" @('-lc', 'cd "$OLDPWD" && cygcheck ./haxe.exe') - & "$(CYG_ROOT)/bin/bash.exe" @('-lc', 'cd "$OLDPWD" && cygcheck ./haxelib.exe') - displayName: Build Haxe - - task: PublishPipelineArtifact@0 - inputs: - artifactName: 'win$(ARCH)Binaries' - targetPath: out \ No newline at end of file diff --git a/extra/azure-pipelines/install-neko-snapshot.yaml b/extra/azure-pipelines/install-neko-snapshot.yaml deleted file mode 100644 index 7086a28f..00000000 --- a/extra/azure-pipelines/install-neko-snapshot.yaml +++ /dev/null @@ -1,33 +0,0 @@ -parameters: - platform: '' # can be linux64, mac, windows, or windows64 - -steps: - - ${{ if startsWith(parameters.platform, 'windows') }}: - - powershell: | - Invoke-WebRequest https://build.haxe.org/builds/neko/${{parameters.platform}}/neko_latest.zip -OutFile $(Agent.TempDirectory)/neko_latest.zip - Expand-Archive $(Agent.TempDirectory)/neko_latest.zip -DestinationPath $(Agent.TempDirectory) - $NEKOPATH = Get-ChildItem $(Agent.TempDirectory)/neko-*-* - Write-Host "##vso[task.prependpath]$NEKOPATH" - Write-Host "##vso[task.setvariable variable=NEKOPATH]$NEKOPATH" - displayName: Install Neko using snapshot from S3 - - ${{ if not(startsWith(parameters.platform, 'windows')) }}: - - bash: | - set -ex - DOWNLOADDIR=$(Agent.TempDirectory) - curl -sSL https://build.haxe.org/builds/neko/${{parameters.platform}}/neko_latest.tar.gz -o $(Agent.TempDirectory)/neko_latest.tar.gz - tar -xf $(Agent.TempDirectory)/neko_latest.tar.gz -C $(Agent.TempDirectory) - NEKOPATH=`echo $(Agent.TempDirectory)/neko-*-*` - sudo mkdir -p /usr/local/bin - sudo mkdir -p /usr/local/lib/neko - sudo ln -s $NEKOPATH/{neko,nekoc,nekoml,nekotools} /usr/local/bin/ - sudo ln -s $NEKOPATH/libneko.* /usr/local/lib/ - sudo ln -s $NEKOPATH/*.ndll /usr/local/lib/neko/ - set +x - echo "##vso[task.prependpath]$NEKOPATH" - echo "##vso[task.setvariable variable=NEKOPATH]$NEKOPATH" - displayName: Install Neko using snapshot from S3 - - ${{ if eq(parameters.platform, 'linux64') }}: - - bash: sudo ldconfig - displayName: ldconfig - - script: neko -version 2>&1 - displayName: Print Neko version \ No newline at end of file diff --git a/extra/azure-pipelines/test-windows.yml b/extra/azure-pipelines/test-windows.yml deleted file mode 100644 index 842eb43c..00000000 --- a/extra/azure-pipelines/test-windows.yml +++ /dev/null @@ -1,87 +0,0 @@ -parameters: - name: 'TestWindows' - vmImage: 'windows-2019' - arch: '64' # or '32' - -jobs: - - job: ${{ parameters.name }} - dependsOn: BuildWin${{ parameters.arch }} - pool: - vmImage: ${{ parameters.vmImage }} - variables: - HAXELIB_ROOT: C:/haxelib - strategy: - matrix: - # https://github.com/HaxeFoundation/haxe/issues/8600 - ${{ if eq(parameters.arch, '64') }}: - macro: - TEST: macro - neko: - TEST: neko - hl: - TEST: hl - cpp: - TEST: cpp - HXCPP_COMPILE_CACHE: C:/hxcache - java: - # https://github.com/HaxeFoundation/haxe/issues/8601 - ${{ if eq(parameters.arch, '64') }}: - TEST: java,jvm - ${{ if eq(parameters.arch, '32') }}: - TEST: java - cs: - TEST: cs - js: - TEST: js - php: - TEST: php - # TODO. flash has never been enabled on our AppVeyor builds. - # flash: - # TEST: flash9 - python: - TEST: python - # TODO. Lua has never been enabled on our AppVeyor builds. - # lua: - # TEST: lua - steps: - - checkout: self - fetchDepth: 20 - - template: install-neko-snapshot.yaml - parameters: - ${{ if eq(parameters.arch, '64') }}: - platform: windows64 - ${{ if eq(parameters.arch, '32') }}: - platform: windows - - task: DownloadPipelineArtifact@0 - inputs: - artifactName: 'win${{ parameters.arch }}Binaries' - targetPath: win${{ parameters.arch }}Binaries - - powershell: | - Set-PSDebug -Trace 1 - 7z x win${{ parameters.arch }}Binaries/*_bin.zip -owin${{ parameters.arch }}Binaries - $dir = Get-ChildItem win${{ parameters.arch }}Binaries/* -Name -Directory - Rename-Item win${{ parameters.arch }}Binaries/$dir haxe - $dir = '' + ( get-location ) + '\win${{ parameters.arch }}Binaries\haxe' - dir $dir - Set-PSDebug -Trace 0 - Write-Host "##vso[task.prependpath]$dir" - displayName: Setup Haxe - - script: haxe -version - displayName: Print Haxe version - - task: UsePythonVersion@0 - inputs: - versionSpec: '3.7' - - powershell: | - Set-PSDebug -Trace 1 - $pypath = python -c "import sys; print(sys.executable)" - $py3path = $pypath.replace("python.exe","python3.exe") - cmd /c mklink $py3path $pypath - python3 -V - displayName: "Make Python 3 be available as python3 in the cmdline" - - script: | - mkdir "$(HAXELIB_ROOT)" - haxelib setup "$(HAXELIB_ROOT)" - displayName: Setup haxelib - - script: haxe RunCi.hxml - workingDirectory: $(Build.SourcesDirectory)/tests - displayName: Test diff --git a/extra/github-actions/Main.hx b/extra/github-actions/Main.hx new file mode 100644 index 00000000..35c2d0b5 --- /dev/null +++ b/extra/github-actions/Main.hx @@ -0,0 +1,46 @@ +package; + +import sys.FileSystem; +import sys.io.File; +import haxe.io.Path; +using StringTools; + +class Main { + + static final matchImport = ~/^([ \t]*)@import (.+)$/gm; + static final matchRunnable = ~/^([ \t]*)jobs:/gm; + + static function main():Void { + final folder = FileSystem.absolutePath("."); + final outFolder = "../../.github"; + + iterFolderItems(folder, (dir, name) -> { + final ext = Path.extension(name); + if (ext != "yaml" && ext != "yml") return; + + final data = File.getContent('$dir/$name'); + var newData = matchImport.map(data, reg -> { + final spaces = reg.matched(1); + final path = reg.matched(2); + final template = File.getContent('./$path'); + final lines = template.split("\n"); + for (i in 0...lines.length) lines[i] = spaces + lines[i]; + lines.join("\n"); + }); + + if (!matchRunnable.match(newData)) return; + final first = "# DO NOT EDIT. Generated from /extra/github-actions\n"; + newData = first + newData; + final relativeDir = dir.replace(folder, ""); + File.saveContent('$outFolder$relativeDir/$name', newData); + }); + } + + static function iterFolderItems(dir:String, func:(dir:String, name:String)->Void):Void { + for (name in FileSystem.readDirectory(dir)) { + if (FileSystem.isDirectory(name)) iterFolderItems('$dir/$name', func); + func(dir, name); + } + } + +} diff --git a/extra/github-actions/build-linux.yml b/extra/github-actions/build-linux.yml new file mode 100644 index 00000000..23a263ed --- /dev/null +++ b/extra/github-actions/build-linux.yml @@ -0,0 +1,61 @@ +- name: Install dependencies + run: | + set -ex + sudo add-apt-repository ppa:avsm/ppa -y # provides OPAM 2 + sudo add-apt-repository ppa:haxe/ocaml -y # provides newer version of mbedtls + sudo apt-get update -qqy + sudo apt-get install -qqy ocaml-nox camlp5 opam libpcre3-dev zlib1g-dev libgtk2.0-dev libmbedtls-dev ninja-build libstring-shellquote-perl + +- name: Install OCaml libraries + run: | + set -ex + opam init # --disable-sandboxing + opam update + opam pin add haxe . --no-action + opam install haxe --deps-only + opam list + ocamlopt -v + +- name: Set ADD_REVISION=1 for non-release + if: ${{ !startsWith(github.ref, 'refs/tags/') }} + run: echo "ADD_REVISION=1" >> $GITHUB_ENV + +- name: Build Haxe + run: | + set -ex + eval $(opam env) + opam config exec -- make -s -j`nproc` STATICLINK=1 haxe + opam config exec -- make -s haxelib + make -s package_unix + ls -l out + ldd -v ./haxe + ldd -v ./haxelib + +# https://stackoverflow.com/questions/58033366/how-to-get-current-branch-within-github-actions +- name: Extract branch name + id: extract_branch + shell: bash + run: echo "##[set-output name=branch;]$(echo ${GITHUB_REF#refs/heads/})" + +- name: Build xmldoc + run: | + set -ex + make -s xmldoc + cat >extra/doc/info.json <> $GITHUB_ENV + +- name: Build Haxe + run: | + set -ex + eval $(opam env) + opam config exec -- make -s -j`sysctl -n hw.ncpu` STATICLINK=1 "LIB_PARAMS=/usr/local/opt/zlib/lib/libz.a /usr/local/lib/libpcre.a /usr/local/lib/libmbedtls.a /usr/local/lib/libmbedcrypto.a /usr/local/lib/libmbedx509.a -cclib '-framework Security -framework CoreFoundation'" haxe + opam config exec -- make -s haxelib + make -s package_unix package_installer_mac + ls -l out + otool -L ./haxe + otool -L ./haxelib + +- name: Upload artifact + uses: actions/upload-artifact@v1.0.0 + with: + name: macBinaries + path: out diff --git a/extra/github-actions/build-windows.yml b/extra/github-actions/build-windows.yml new file mode 100644 index 00000000..e16de4d9 --- /dev/null +++ b/extra/github-actions/build-windows.yml @@ -0,0 +1,61 @@ +- name: choco install nsis + uses: nick-invision/retry@v1 + with: + timeout_minutes: 10 + max_attempts: 10 + command: choco install --no-progress nsis.portable --version 3.02 -y +- name: choco install things + shell: pwsh + run: choco install --no-progress curl wget 7zip.portable -y +- name: Prepend Chocolatey path + shell: pwsh + run: Write-Host "::add-path::C:\ProgramData\chocolatey\bin" + +- name: Install OCaml and OCaml libraries + shell: pwsh + run: | + Set-PSDebug -Trace 1 + curl.exe -fsSL -o cygwin-setup.exe --retry 3 $($env:CYGWIN_SETUP) + Start-Process -FilePath "cygwin-setup.exe" -ArgumentList "-B -q -R $($env:CYG_ROOT) -l C:/tmp -s $($env:CYG_MIRROR) -P default -P make -P git -P zlib-devel -P rsync -P patch -P diffutils -P curl -P unzip -P tar -P m4 -P perl -P libpcre-devel -P mbedtls-devel -P mingw64-$($env:MINGW_ARCH)-zlib -P mingw64-$($env:MINGW_ARCH)-gcc-core -P mingw64-$($env:MINGW_ARCH)-pcre -P perl-IPC-System-Simple" -Wait + curl.exe -fsSL -o "opam.tar.xz" --retry 3 https://github.com/fdopen/opam-repository-mingw/releases/download/0.0.0.2/opam$($env:ARCH).tar.xz + curl.exe -fsSL -o "libmbedtls.tar.xz" --retry 3 https://github.com/Simn/mingw64-mbedtls/releases/download/2.16.3/mingw64-$($env:MINGW_ARCH)-mbedtls-2.16.3-1.tar.xz + & "$($env:CYG_ROOT)/bin/bash.exe" @('-lc', 'curl -L https://cpanmin.us | perl - App::cpanminus') + & "$($env:CYG_ROOT)/bin/bash.exe" @('-lc', 'cpanm String::ShellQuote') + & "$($env:CYG_ROOT)/bin/bash.exe" @('-lc', 'echo "$OLDPWD"') + & "$($env:CYG_ROOT)/bin/bash.exe" @('-lc', 'cd "$OLDPWD" && tar -C / -xvf libmbedtls.tar.xz') + & "$($env:CYG_ROOT)/bin/bash.exe" @('-lc', 'cd "$OLDPWD" && tar -xf opam.tar.xz') + & "$($env:CYG_ROOT)/bin/bash.exe" @('-lc', 'cd "$OLDPWD" && bash opam${ARCH}/install.sh') + & "$($env:CYG_ROOT)/bin/bash.exe" @('-lc', 'opam init mingw "https://github.com/fdopen/opam-repository-mingw.git#opam2" --comp 4.07.0+mingw${ARCH}c --switch 4.07.0+mingw${ARCH}c --auto-setup --yes 2>&1') + & "$($env:CYG_ROOT)/bin/bash.exe" @('-lc', 'opam update --yes 2>&1') + & "$($env:CYG_ROOT)/bin/bash.exe" @('-lc', 'cd "$OLDPWD" && opam pin add haxe . --kind=path --no-action --yes 2>&1') + & "$($env:CYG_ROOT)/bin/bash.exe" @('-lc', 'opam install haxe --deps-only --yes 2>&1') + & "$($env:CYG_ROOT)/bin/bash.exe" @('-lc', 'opam pin add luv https://github.com/aantron/luv.git#44db25c2b2669f9d1373377006a4d5850e0820e3 --yes 2>&1') + & "$($env:CYG_ROOT)/bin/bash.exe" @('-lc', 'opam list') + & "$($env:CYG_ROOT)/bin/bash.exe" @('-lc', 'ocamlopt -v') + +- name: Expose mingw dll files + shell: pwsh + run: Write-Host "::add-path::${env:CYG_ROOT}/usr/$($env:MINGW_ARCH)-w64-mingw32/sys-root/mingw/bin" + +- name: Set ADD_REVISION=1 for non-release + if: ${{ !startsWith(github.ref, 'refs/tags/') }} + shell: pwsh + run: echo "ADD_REVISION=1" >> $Env:GITHUB_ENV + +- name: Build Haxe + shell: pwsh + run: | + Set-PSDebug -Trace 1 + & "$($env:CYG_ROOT)/bin/bash.exe" @('-lc', 'cd "$OLDPWD" && opam config exec -- make -s -f Makefile.win -j`nproc` haxe 2>&1') + & "$($env:CYG_ROOT)/bin/bash.exe" @('-lc', 'cd "$OLDPWD" && opam config exec -- make -s -f Makefile.win haxelib 2>&1') + & "$($env:CYG_ROOT)/bin/bash.exe" @('-lc', 'cd "$OLDPWD" && opam config exec -- make -f Makefile.win echo_package_files package_bin package_installer_win package_choco 2>&1') + dir out + & "$($env:CYG_ROOT)/bin/bash.exe" @('-lc', 'cd "$OLDPWD" && cygcheck ./haxe.exe') + & "$($env:CYG_ROOT)/bin/bash.exe" @('-lc', 'cd "$OLDPWD" && cygcheck ./haxelib.exe') + & "$($env:CYG_ROOT)/bin/bash.exe" @('-lc', 'cd "$OLDPWD" && ls ./out') + +- name: Upload artifact + uses: actions/upload-artifact@v1.0.0 + with: + name: win${{env.ARCH}}Binaries + path: out diff --git a/extra/github-actions/build.hxml b/extra/github-actions/build.hxml new file mode 100644 index 00000000..e2a3d27a --- /dev/null +++ b/extra/github-actions/build.hxml @@ -0,0 +1,2 @@ +--main Main +--interp diff --git a/extra/github-actions/install-neko.yml b/extra/github-actions/install-neko.yml new file mode 100644 index 00000000..0311ea5e --- /dev/null +++ b/extra/github-actions/install-neko.yml @@ -0,0 +1,27 @@ +- name: Install Neko using snapshot from S3 (Unix) + if: ${{ !startsWith(env.PLATFORM, 'windows') }} + run: | + set -ex + + curl -sSL https://build.haxe.org/builds/neko/$PLATFORM/neko_latest.tar.gz -o $RUNNER_TEMP/neko_latest.tar.gz + tar -xf $RUNNER_TEMP/neko_latest.tar.gz -C $RUNNER_TEMP + NEKOPATH=`echo $RUNNER_TEMP/neko-*-*` + sudo mkdir -p /usr/local/bin + sudo mkdir -p /usr/local/lib/neko + sudo ln -s $NEKOPATH/{neko,nekoc,nekoml,nekotools} /usr/local/bin/ + sudo ln -s $NEKOPATH/libneko.* /usr/local/lib/ + sudo ln -s $NEKOPATH/*.ndll /usr/local/lib/neko/ + echo "NEKOPATH=$NEKOPATH" >> $GITHUB_ENV + +- name: Install Neko using snapshot from S3 (Windows) + if: ${{ startsWith(env.PLATFORM, 'windows') }} + shell: pwsh + run: | + Invoke-WebRequest https://build.haxe.org/builds/neko/$env:PLATFORM/neko_latest.zip -OutFile $env:RUNNER_TEMP/neko_latest.zip + Expand-Archive $env:RUNNER_TEMP/neko_latest.zip -DestinationPath $env:RUNNER_TEMP + $NEKOPATH = Get-ChildItem $env:RUNNER_TEMP/neko-*-* + echo "$NEKOPATH" >> $env:GITHUB_PATH + echo "NEKOPATH=$NEKOPATH" >> $env:GITHUB_ENV + +- name: Print Neko version + run: neko -version 2>&1 diff --git a/extra/github-actions/test-linux.yml b/extra/github-actions/test-linux.yml new file mode 100644 index 00000000..e42e7b47 --- /dev/null +++ b/extra/github-actions/test-linux.yml @@ -0,0 +1,46 @@ +- name: Setup Haxe + run: | + # mkdir ./linuxBinaries + # curl -sSL https://build.haxe.org/builds/haxe/linux64/haxe_latest.tar.gz -o ./linuxBinaries/haxe_bin.tar.gz + + sudo apt install -qqy libmbedtls-dev + + set -ex + tar -xf linuxBinaries/*_bin.tar.gz -C linuxBinaries --strip-components=1 + sudo mkdir -p /usr/local/bin/ + sudo mkdir -p /usr/local/share/haxe/ + sudo ln -s `pwd`/linuxBinaries/haxe /usr/local/bin/haxe + sudo ln -s `pwd`/linuxBinaries/haxelib /usr/local/bin/haxelib + sudo ln -s `pwd`/linuxBinaries/std /usr/local/share/haxe/std + +- name: Print Haxe version + run: haxe -version + +- name: Setup haxelib + run: | + set -ex + mkdir ~/haxelib + haxelib setup ~/haxelib + +- name: Install apt packages + if: matrix.APT_PACKAGES + run: | + set -ex + sudo apt update -qqy + sudo apt install -qqy ${{matrix.APT_PACKAGES}} + +- name: Flash setup + if: matrix.target == 'flash9' + run: export DISPLAY=:99.0 + +- name: Test + if: success() && !(matrix.SAUCE && matrix.SAUCE_ACCESS_KEY) + run: haxe RunCi.hxml + working-directory: ${{github.workspace}}/tests + +- name: Test (with SauceLabs) + if: matrix.target == 'js' && success() && matrix.SAUCE && matrix.SAUCE_ACCESS_KEY + run: haxe RunCi.hxml + working-directory: ${{github.workspace}}/tests + env: + SAUCE_ACCESS_KEY: matrix.SAUCE_ACCESS_KEY diff --git a/extra/github-actions/test-mac.yml b/extra/github-actions/test-mac.yml new file mode 100644 index 00000000..19cfce15 --- /dev/null +++ b/extra/github-actions/test-mac.yml @@ -0,0 +1,32 @@ +- name: Setup Haxe + run: | + # mkdir ./macBinaries + # curl -sSL https://build.haxe.org/builds/haxe/mac/haxe_latest.tar.gz -o ./macBinaries/haxe_bin.tar.gz + + set -ex + tar -xf macBinaries/*_bin.tar.gz -C macBinaries --strip-components=1 + sudo mkdir -p /usr/local/bin/ + sudo mkdir -p /usr/local/share/haxe/ + sudo ln -s `pwd`/macBinaries/haxe /usr/local/bin/haxe + sudo ln -s `pwd`/macBinaries/haxelib /usr/local/bin/haxelib + sudo ln -s `pwd`/macBinaries/std /usr/local/share/haxe/std + +- name: Print Haxe version + run: haxe -version + +- name: Setup haxelib + run: | + set -ex + mkdir ~/haxelib + haxelib setup ~/haxelib + +- name: Install homebrew packages + if: matrix.BREW_PACKAGES + run: brew install ${{matrix.BREW_PACKAGES}} + +- name: Test + run: | + # disable invalid Unicode filenames on APFS + echo "" > sys/compile-fs.hxml + haxe RunCi.hxml + working-directory: ${{github.workspace}}/tests diff --git a/extra/github-actions/test-windows.yml b/extra/github-actions/test-windows.yml new file mode 100644 index 00000000..2056ab9d --- /dev/null +++ b/extra/github-actions/test-windows.yml @@ -0,0 +1,48 @@ +# - name: Quick test +# shell: pwsh +# run: | +# $DOWNLOADDIR="./win$($env:ARCH)Binaries" +# new-item -Name $DOWNLOADDIR -ItemType directory +# Invoke-WebRequest https://build.haxe.org/builds/haxe/$env:PLATFORM/haxe_latest.zip -OutFile $DOWNLOADDIR/haxe_bin.zip + +- name: Setup Haxe + shell: pwsh + run: | + $DOWNLOADDIR="./win$($env:ARCH)Binaries" + Expand-Archive $DOWNLOADDIR/*_bin.zip -DestinationPath $DOWNLOADDIR + Set-PSDebug -Trace 1 + $HAXEPATH = Get-ChildItem $DOWNLOADDIR/haxe_*_* -Directory + Write-Host "::add-path::$HAXEPATH" + Write-Host "::set-env name=HAXELIB_ROOT::$HAXEPATH\lib" + +- name: Print Haxe version + shell: pwsh + run: haxe -version + +- name: "Make Python 3 be available as python3 in the cmdline" + shell: pwsh + run: | + Set-PSDebug -Trace 1 + $pypath = python -c "import sys; print(sys.executable)" + $py3path = $pypath.replace("python.exe","python3.exe") + cmd /c mklink $py3path $pypath + python3 -V + +- name: Install hererocks + if: matrix.target == 'lua' + shell: cmd + run: | + pip install hererocks + hererocks lua53 -l5.3 -rlatest + call lua53/bin/activate + +- name: Setup haxelib + shell: pwsh + run: | + mkdir "$env:HAXELIB_ROOT" + haxelib setup "$env:HAXELIB_ROOT" + +- name: Test + shell: pwsh + run: haxe RunCi.hxml + working-directory: ${{github.workspace}}/tests diff --git a/extra/github-actions/workflows/main.yml b/extra/github-actions/workflows/main.yml new file mode 100644 index 00000000..bba0cc91 --- /dev/null +++ b/extra/github-actions/workflows/main.yml @@ -0,0 +1,300 @@ +# TODO: support skip ci (https://github.community/t/github-actions-does-not-respect-skip-ci/17325/8) + +name: CI +on: [push, pull_request] + +jobs: + cancel: + name: "Cancel previous runs" + runs-on: ubuntu-latest + timeout-minutes: 3 + steps: + - uses: styfle/cancel-workflow-action@0.3.1 + with: + workflow_id: 1447568 + access_token: ${{ github.token }} + + windows64-build: + runs-on: windows-latest + env: + ACTIONS_ALLOW_UNSECURE_COMMANDS: true + PLATFORM: windows64 + OPAMYES: 1 + CYG_MIRROR: http://mirrors.kernel.org/sourceware/cygwin/ + ARCH: 64 + MINGW_ARCH: x86_64 + CYGWIN_SETUP: https://cygwin.com/setup-x86_64.exe + CYG_ROOT: C:/cygwin64 + steps: + - uses: actions/checkout@main + with: + submodules: recursive + + @import install-neko.yml + @import build-windows.yml + + windows-build: + runs-on: windows-latest + env: + ACTIONS_ALLOW_UNSECURE_COMMANDS: true + PLATFORM: windows + OPAMYES: 1 + CYG_MIRROR: http://mirrors.kernel.org/sourceware/cygwin/ + ARCH: 32 + MINGW_ARCH: i686 + CYGWIN_SETUP: https://cygwin.com/setup-x86.exe + CYG_ROOT: C:/cygwin + steps: + - uses: actions/checkout@main + with: + submodules: recursive + + @import install-neko.yml + @import build-windows.yml + + linux-build: + runs-on: ubuntu-latest + env: + PLATFORM: linux64 + OPAMYES: 1 + steps: + - uses: actions/checkout@main + with: + submodules: recursive + + @import install-neko.yml + @import build-linux.yml + + mac-build: + runs-on: macos-latest + env: + PLATFORM: mac + OPAMYES: 1 + steps: + - uses: actions/checkout@main + with: + submodules: recursive + + @import install-neko.yml + @import build-mac.yml + + windows64-test: + needs: windows64-build + runs-on: windows-latest + env: + ACTIONS_ALLOW_UNSECURE_COMMANDS: true + PLATFORM: windows64 + TEST: ${{matrix.target}} + HXCPP_COMPILE_CACHE: ~/hxcache + ARCH: 64 + strategy: + fail-fast: false + matrix: + # TODO enable lua after https://github.com/HaxeFoundation/haxe/issues/5024 + target: [macro, js, hl, cpp, 'java,jvm', cs, php, python, neko] + steps: + - uses: actions/checkout@main + with: + submodules: recursive + - uses: actions/download-artifact@v1 + with: + name: win${{env.ARCH}}Binaries + + @import install-neko.yml + @import test-windows.yml + + windows-test: + needs: windows-build + runs-on: windows-latest + env: + ACTIONS_ALLOW_UNSECURE_COMMANDS: true + PLATFORM: windows + TEST: ${{matrix.target}} + HXCPP_COMPILE_CACHE: ~/hxcache + ARCH: 32 + strategy: + fail-fast: false + matrix: + # TODO jvm: https://github.com/HaxeFoundation/haxe/issues/8601 + # TODO enable lua after https://github.com/HaxeFoundation/haxe/issues/5024 + target: [macro, js, hl, cpp, java, cs, php, python, neko] + steps: + - uses: actions/checkout@main + with: + submodules: recursive + - uses: actions/download-artifact@v1 + with: + name: win${{env.ARCH}}Binaries + + @import install-neko.yml + @import test-windows.yml + + linux-test: + needs: linux-build + runs-on: ubuntu-latest + env: + PLATFORM: linux64 + TEST: ${{matrix.target}} + HXCPP_COMPILE_CACHE: ~/hxcache + strategy: + fail-fast: false + matrix: + target: [macro, js, hl, cpp, 'java,jvm', cs, php, python, lua, flash9, neko] + include: + - target: js + # SAUCE: 1 + # SAUCE_TUNNEL_ID: 'linux-test' + # SAUCE_BUILD: '${{env.GITHUB_RUN_NUMBER}}' # $(Build.BuildNumber) + - target: hl + APT_PACKAGES: cmake ninja-build libturbojpeg-dev + - target: cpp + APT_PACKAGES: gcc-multilib g++-multilib + - target: lua + APT_PACKAGES: ncurses-dev + - target: flash9 + APT_PACKAGES: libglib2.0 libfreetype6 xvfb + steps: + - uses: actions/checkout@main + with: + submodules: recursive + - uses: actions/download-artifact@v1 + with: + name: linuxBinaries + + @import install-neko.yml + @import test-linux.yml + + mac-test: + needs: mac-build + runs-on: macos-latest + env: + PLATFORM: mac + TEST: ${{matrix.target}} + HXCPP_COMPILE_CACHE: ~/hxcache + strategy: + fail-fast: false + matrix: + target: [macro, js, hl, cpp, 'java,jvm', cs, php, python, lua, flash9, neko] + include: + - target: hl + BREW_PACKAGES: ninja + steps: + - uses: actions/checkout@main + with: + submodules: recursive + - uses: actions/download-artifact@v1 + with: + name: macBinaries + + @import install-neko.yml + @import test-mac.yml + + deploy: + if: github.event_name != 'pull_request' + needs: [linux-test, mac-test, windows-test, windows64-test] + runs-on: ubuntu-latest + steps: + # this is only needed for to get `COMMIT_DATE`... + # maybe https://github.community/t/expose-commit-timestamp-in-the-github-context-data/16460/3 + # would be faster + - name: Checkout the repository + uses: actions/checkout@main + + - name: Download build artifacts + uses: actions/download-artifact@v2 + + - name: Install awscli + run: | + set -ex + sudo apt-get update -qqy + sudo apt-get install -qqy awscli + + # https://stackoverflow.com/questions/58033366/how-to-get-current-branch-within-github-actions + - name: Extract branch name + id: extract_branch + shell: bash + run: echo "##[set-output name=branch;]$(echo ${GITHUB_REF#refs/heads/})" + + - name: Upload binaries + shell: bash + env: + AWS_ACCESS_KEY_ID: ${{ secrets.HXBUILDS_AWS_ACCESS_KEY_ID }} + AWS_SECRET_ACCESS_KEY: ${{ secrets.HXBUILDS_AWS_SECRET_ACCESS_KEY }} + HXBUILDS_S3ADDR: ${{ secrets.HXBUILDS_S3ADDR }} + run: | + set -ex + COMMIT_HASH_SHORT=${GITHUB_SHA:0:7} + COMMIT_DATE=`TZ=UTC git show --quiet --date='format-local:%Y-%m-%d' --format="%cd"` + FILE_NAME=haxe_${COMMIT_DATE}_${{ steps.extract_branch.outputs.branch }}_${COMMIT_HASH_SHORT} + aws s3 cp linuxBinaries/*_bin.tar.gz ${HXBUILDS_S3ADDR}/haxe/linux64/${FILE_NAME}.tar.gz + aws s3 cp macBinaries/*_bin.tar.gz ${HXBUILDS_S3ADDR}/haxe/mac/${FILE_NAME}.tar.gz + aws s3 cp macBinaries/*_installer.tar.gz ${HXBUILDS_S3ADDR}/haxe/mac-installer/${FILE_NAME}.tar.gz + aws s3 cp win64Binaries/*_bin.zip ${HXBUILDS_S3ADDR}/haxe/windows64/${FILE_NAME}.zip + aws s3 cp win64Binaries/*_installer.zip ${HXBUILDS_S3ADDR}/haxe/windows64-installer/${FILE_NAME}.zip + aws s3 cp win64Binaries/*.nupkg ${HXBUILDS_S3ADDR}/haxe/windows64-choco/ + aws s3 cp win32Binaries/*_bin.zip ${HXBUILDS_S3ADDR}/haxe/windows/${FILE_NAME}.zip + aws s3 cp win32Binaries/*_installer.zip ${HXBUILDS_S3ADDR}/haxe/windows-installer/${FILE_NAME}.zip + aws s3 cp win32Binaries/*.nupkg ${HXBUILDS_S3ADDR}/haxe/windows-choco/ + + - name: Update "latest" + if: github.ref == 'refs/heads/development' + shell: bash + env: + AWS_ACCESS_KEY_ID: ${{ secrets.HXBUILDS_AWS_ACCESS_KEY_ID }} + AWS_SECRET_ACCESS_KEY: ${{ secrets.HXBUILDS_AWS_SECRET_ACCESS_KEY }} + HXBUILDS_S3ADDR: ${{ secrets.HXBUILDS_S3ADDR }} + run: | + set -ex + aws s3 cp linuxBinaries/*_bin.tar.gz ${HXBUILDS_S3ADDR}/haxe/linux64/haxe_latest.tar.gz + aws s3 cp macBinaries/*_bin.tar.gz ${HXBUILDS_S3ADDR}/haxe/mac/haxe_latest.tar.gz + aws s3 cp macBinaries/*_installer.tar.gz ${HXBUILDS_S3ADDR}/haxe/mac-installer/haxe_latest.tar.gz + aws s3 cp win64Binaries/*_bin.zip ${HXBUILDS_S3ADDR}/haxe/windows64/haxe_latest.zip + aws s3 cp win64Binaries/*_installer.zip ${HXBUILDS_S3ADDR}/haxe/windows64-installer/haxe_latest.zip + aws s3 cp win32Binaries/*_bin.zip ${HXBUILDS_S3ADDR}/haxe/windows/haxe_latest.zip + aws s3 cp win32Binaries/*_installer.zip ${HXBUILDS_S3ADDR}/haxe/windows-installer/haxe_latest.zip + + # Chocolatey packages have to be named with version number, + # so let's use web redirection to keep the original file name. + [[ "$HXBUILDS_S3ADDR" =~ s3://([^/]+)(.*) ]] && HXBUILDS_S3BUCKET="${BASH_REMATCH[1]}" && HXBUILDS_S3PATH="${BASH_REMATCH[2]}" + [[ `echo win64Binaries/*.nupkg` =~ win64Binaries/(.+) ]] && FILE_NAME="${BASH_REMATCH[1]}" + aws s3 cp ${HXBUILDS_S3ADDR}/haxe/windows64-choco/${FILE_NAME} ${HXBUILDS_S3ADDR}/haxe/windows64-choco/haxe_latest.nupkg --acl public-read --website-redirect "${HXBUILDS_S3PATH}/haxe/windows64-choco/${FILE_NAME}" + [[ `echo win32Binaries/*.nupkg` =~ win32Binaries/(.+) ]] && FILE_NAME="${BASH_REMATCH[1]}" + aws s3 cp ${HXBUILDS_S3ADDR}/haxe/windows-choco/${FILE_NAME} ${HXBUILDS_S3ADDR}/haxe/windows-choco/haxe_latest.nupkg --acl public-read --website-redirect "${HXBUILDS_S3PATH}/haxe/windows-choco/${FILE_NAME}" + + deploy_apidoc: + if: github.event_name != 'pull_request' # TODO: also only when `GHP_REMOTE` is present + needs: [linux-test, mac-test, windows-test, windows64-test] + runs-on: ubuntu-latest + steps: + - name: Download Haxe + uses: actions/download-artifact@v2 + with: + name: linuxBinaries + path: linuxBinaries + + - name: Setup Haxe + run: | + set -ex + tar -xf linuxBinaries/*_bin.tar.gz -C linuxBinaries --strip-components=1 + sudo mkdir -p /usr/local/bin/ + sudo mkdir -p /usr/local/share/haxe/ + sudo ln -s `pwd`/linuxBinaries/haxe /usr/local/bin/haxe + sudo ln -s `pwd`/linuxBinaries/haxelib /usr/local/bin/haxelib + sudo ln -s `pwd`/linuxBinaries/std /usr/local/share/haxe/std + + - name: Download xmldoc artifact + uses: actions/download-artifact@v2 + with: + name: xmldoc + path: xmldoc + + - name: Deploy to api.haxe.org + env: + GHP_EMAIL: haxe-ci@onthewings.net + GHP_USERNAME: Haxe CI Bot + GHP_REMOTE: ${{ secrets.GHP_REMOTE }} + run: | + set -ex + LOCAL="`pwd`/extra/api.haxe.org" + git clone "${GHP_REMOTE}" "${LOCAL}" + haxe --cwd "${LOCAL}" --run ImportXml "`pwd`/xmldoc" diff --git a/libs/README.md b/libs/README.md deleted file mode 100644 index 2298a441..00000000 --- a/libs/README.md +++ /dev/null @@ -1,5 +0,0 @@ -# ocamllibs - -[![TravisCI Build Status](https://travis-ci.org/HaxeFoundation/ocamllibs.svg?branch=master)](https://travis-ci.org/HaxeFoundation/ocamllibs) - -Various OCaml libraries. diff --git a/libs/extc/process_stubs.c b/libs/extc/process_stubs.c index a8bedb5a..c17c7a4f 100644 --- a/libs/extc/process_stubs.c +++ b/libs/extc/process_stubs.c @@ -25,6 +25,7 @@ #include #include #include +#include #include #include @@ -57,20 +58,15 @@ #endif // --- neko-to-caml api -- -#define val_check(v,t) -#define val_check_kind(v,k) #define val_data(v) v #define val_array_size(v) Wosize_val(v) #define val_array_ptr(v) (&Field(v,0)) #define val_string(v) String_val(v) #define val_strlen(v) caml_string_length(v) -#define alloc_abstract(_,data) ((value)data) #define alloc_int(i) Val_int(i) -#define val_gc(v,callb) #define val_null Val_int(0) #define val_some(v) Field(v,0) #define val_int(v) Int_val(v) -#define DEFINE_KIND(_) #define neko_error() failwith(__FUNCTION__) static value alloc_private( int size ) { @@ -200,9 +196,7 @@ typedef struct { #endif } vprocess; -DEFINE_KIND(k_process); - -#define val_process(v) ((vprocess*)val_data(v)) +#define val_process(v) (*((vprocess**) Data_custom_val(v))) /** @@ -225,6 +219,9 @@ static int do_close( int fd ) { static void free_process( value vp ) { vprocess *p = val_process(vp); + if (p == NULL) { + return; + } # ifdef _WIN32 CloseHandle(p->eread); CloseHandle(p->oread); @@ -236,8 +233,18 @@ static void free_process( value vp ) { do_close(p->oread); do_close(p->iwrite); # endif + free(p); } +static struct custom_operations vprocess_ops = { + .identifier = "vprocess_ops", + .finalize = custom_finalize_default, + .compare = custom_compare_default, + .hash = custom_hash_default, + .serialize = custom_serialize_default, + .deserialize = custom_deserialize_default, +}; + /** process_run : cmd:string -> args:string array option -> 'process @@ -249,13 +256,13 @@ static void free_process( value vp ) { **/ CAMLprim value process_run( value cmd, value vargs ) { - CAMLparam2(cmd,vargs); + CAMLparam2(cmd, vargs); + CAMLlocal1(vp); int i, isRaw; vprocess *p; - val_check(cmd,string); + vp = caml_alloc_custom(&vprocess_ops, sizeof(vprocess*), 0, 1); isRaw = vargs == val_null; if (!isRaw) { - val_check(vargs,array); vargs = val_some(vargs); } # ifdef _WIN32 @@ -286,7 +293,6 @@ CAMLprim value process_run( value cmd, value vargs ) { int j,len; unsigned int bs_count = 0; unsigned int k; - val_check(v,string); len = val_strlen(v); buffer_append_str(b," \""); for(j=0;jpid = fork(); if( p->pid == -1 ) { do_close(input[0]); @@ -406,20 +411,13 @@ CAMLprim value process_run( value cmd, value vargs ) { p->oread = output[0]; p->eread = error[0]; # endif - { - CAMLlocal1(vp); - vp = alloc_abstract(k_process,p); - val_gc(vp,free_process); - CAMLreturn(vp); - } + val_process(vp) = p; + CAMLreturn(vp); } #define CHECK_ARGS() \ + CAMLparam4(vp, str, pos, len); \ vprocess *p; \ - val_check_kind(vp,k_process); \ - val_check(str,string); \ - val_check(pos,int); \ - val_check(len,int); \ if( val_int(pos) < 0 || val_int(len) < 0 || val_int(pos) + val_int(len) > val_strlen(str) ) \ neko_error(); \ p = val_process(vp); \ @@ -440,7 +438,7 @@ CAMLprim value process_stdout_read( value vp, value str, value pos, value len ) DWORD nbytes; if( !ReadFile(p->oread,val_string(str)+val_int(pos),val_int(len),&nbytes,NULL) ) neko_error(); - return alloc_int(nbytes); + CAMLreturn(alloc_int(nbytes)); } # else int nbytes; @@ -452,7 +450,7 @@ CAMLprim value process_stdout_read( value vp, value str, value pos, value len ) } if( nbytes == 0 ) neko_error(); - return alloc_int(nbytes); + CAMLreturn(alloc_int(nbytes)); # endif } @@ -471,7 +469,7 @@ CAMLprim value process_stderr_read( value vp, value str, value pos, value len ) DWORD nbytes; if( !ReadFile(p->eread,val_string(str)+val_int(pos),val_int(len),&nbytes,NULL) ) neko_error(); - return alloc_int(nbytes); + CAMLreturn(alloc_int(nbytes)); } # else int nbytes; @@ -483,7 +481,7 @@ CAMLprim value process_stderr_read( value vp, value str, value pos, value len ) } if( nbytes == 0 ) neko_error(); - return alloc_int(nbytes); + CAMLreturn(alloc_int(nbytes)); # endif } @@ -502,7 +500,7 @@ CAMLprim value process_stdin_write( value vp, value str, value pos, value len ) DWORD nbytes; if( !WriteFile(p->iwrite,val_string(str)+val_int(pos),val_int(len),&nbytes,NULL) ) neko_error(); - return alloc_int(nbytes); + CAMLreturn(alloc_int(nbytes)); } # else int nbytes; @@ -512,7 +510,7 @@ CAMLprim value process_stdin_write( value vp, value str, value pos, value len ) HANDLE_EINTR(stdin_write_again); neko_error(); } - return alloc_int(nbytes); + CAMLreturn(alloc_int(nbytes)); # endif } @@ -523,9 +521,8 @@ CAMLprim value process_stdin_write( value vp, value str, value pos, value len ) **/ CAMLprim value process_stdin_close( value vp ) { - vprocess *p; - val_check_kind(vp,k_process); - p = val_process(vp); + CAMLparam1(vp); + vprocess *p = val_process(vp); # ifdef _WIN32 if( !CloseHandle(p->iwrite) ) neko_error(); @@ -534,7 +531,7 @@ CAMLprim value process_stdin_close( value vp ) { neko_error(); p->iwrite = -1; # endif - return val_null; + CAMLreturn(val_null); } /** @@ -544,16 +541,15 @@ CAMLprim value process_stdin_close( value vp ) { **/ CAMLprim value process_exit( value vp ) { - vprocess *p; - val_check_kind(vp,k_process); - p = val_process(vp); + CAMLparam1(vp); + vprocess *p = val_process(vp); # ifdef _WIN32 { DWORD rval; WaitForSingleObject(p->pinf.hProcess,INFINITE); if( !GetExitCodeProcess(p->pinf.hProcess,&rval) ) neko_error(); - return alloc_int(rval); + CAMLreturn(alloc_int(rval)); } # else int rval; @@ -564,7 +560,7 @@ CAMLprim value process_exit( value vp ) { } if( !WIFEXITED(rval) ) neko_error(); - return alloc_int(WEXITSTATUS(rval)); + CAMLreturn(alloc_int(WEXITSTATUS(rval))); # endif } @@ -575,13 +571,12 @@ CAMLprim value process_exit( value vp ) { **/ CAMLprim value process_pid( value vp ) { - vprocess *p; - val_check_kind(vp,k_process); - p = val_process(vp); + CAMLparam1(vp); + vprocess *p = val_process(vp); # ifdef _WIN32 - return alloc_int(p->pinf.dwProcessId); + CAMLreturn(alloc_int(p->pinf.dwProcessId)); # else - return alloc_int(p->pid); + CAMLreturn(alloc_int(p->pid)); # endif } @@ -592,11 +587,10 @@ CAMLprim value process_pid( value vp ) { **/ CAMLprim value process_close( value vp ) { - val_check_kind(vp,k_process); + CAMLparam1(vp); free_process(vp); //val_kind(vp) = NULL; - //val_gc(vp,NULL); - return val_null; + CAMLreturn(val_null); } /** @@ -606,13 +600,13 @@ CAMLprim value process_close( value vp ) { **/ CAMLprim value process_kill( value vp ) { - val_check_kind(vp,k_process); + CAMLparam1(vp); # ifdef _WIN32 TerminateProcess(val_process(vp)->pinf.hProcess,-1); # else kill(val_process(vp)->pid,9); # endif - return val_null; + CAMLreturn(val_null); } diff --git a/libs/extlib-leftovers/base64.ml b/libs/extlib-leftovers/base64.ml new file mode 100644 index 00000000..e19cadc4 --- /dev/null +++ b/libs/extlib-leftovers/base64.ml @@ -0,0 +1,130 @@ +(* + * Base64 - Base64 codec + * Copyright (C) 2003 Nicolas Cannasse + * + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Lesser General Public + * License as published by the Free Software Foundation; either + * version 2.1 of the License, or (at your option) any later version, + * with the special exception on linking described in file LICENSE. + * + * This library 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 + * Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + *) + +open ExtBytes + +exception Invalid_char +exception Invalid_table + +external unsafe_char_of_int : int -> char = "%identity" + +type encoding_table = char array +type decoding_table = int array + +let chars = [| + 'A';'B';'C';'D';'E';'F';'G';'H';'I';'J';'K';'L';'M';'N';'O';'P'; + 'Q';'R';'S';'T';'U';'V';'W';'X';'Y';'Z';'a';'b';'c';'d';'e';'f'; + 'g';'h';'i';'j';'k';'l';'m';'n';'o';'p';'q';'r';'s';'t';'u';'v'; + 'w';'x';'y';'z';'0';'1';'2';'3';'4';'5';'6';'7';'8';'9';'+';'/' +|] + +let make_decoding_table tbl = + if Array.length tbl <> 64 then raise Invalid_table; + let d = Array.make 256 (-1) in + for i = 0 to 63 do + Array.unsafe_set d (int_of_char (Array.unsafe_get tbl i)) i; + done; + d + +let inv_chars = make_decoding_table chars + +let encode ?(tbl=chars) ch = + if Array.length tbl <> 64 then raise Invalid_table; + let data = ref 0 in + let count = ref 0 in + let flush() = + if !count > 0 then begin + let d = (!data lsl (6 - !count)) land 63 in + IO.write ch (Array.unsafe_get tbl d); + end; + in + let write c = + let c = int_of_char c in + data := (!data lsl 8) lor c; + count := !count + 8; + while !count >= 6 do + count := !count - 6; + let d = (!data asr !count) land 63 in + IO.write ch (Array.unsafe_get tbl d) + done; + in + let output s p l = + for i = p to p + l - 1 do + write (Bytes.unsafe_get s i) + done; + l + in + IO.create_out ~write ~output + ~flush:(fun () -> flush(); IO.flush ch) + ~close:(fun() -> flush(); IO.close_out ch) + +let decode ?(tbl=inv_chars) ch = + if Array.length tbl <> 256 then raise Invalid_table; + let data = ref 0 in + let count = ref 0 in + let rec fetch() = + if !count >= 8 then begin + count := !count - 8; + let d = (!data asr !count) land 0xFF in + unsafe_char_of_int d + end else + let c = int_of_char (IO.read ch) in + let c = Array.unsafe_get tbl c in + if c = -1 then raise Invalid_char; + data := (!data lsl 6) lor c; + count := !count + 6; + fetch() + in + let read = fetch in + let input s p l = + let i = ref 0 in + try + while !i < l do + Bytes.unsafe_set s (p + !i) (fetch()); + incr i; + done; + l + with + IO.No_more_input when !i > 0 -> + !i + in + let close() = + count := 0; + IO.close_in ch + in + IO.create_in ~read ~input ~close + +let str_encode ?(tbl=chars) s = + let ch = encode ~tbl (IO.output_bytes()) in + IO.nwrite_string ch s; + IO.close_out ch + +let str_decode ?(tbl=inv_chars) s = + let ch = decode ~tbl (IO.input_bytes s) in + IO.nread_string ch ((Bytes.length s * 6) / 8) + +let encode_string ?(tbl=chars) s = + let ch = encode ~tbl (IO.output_string ()) in + IO.nwrite_string ch s; + IO.close_out ch + +let decode_string ?(tbl=inv_chars) s = + let ch = decode ~tbl (IO.input_string s) in + IO.nread_string ch ((String.length s * 6) / 8) diff --git a/libs/extlib-leftovers/base64.mli b/libs/extlib-leftovers/base64.mli new file mode 100644 index 00000000..bc409421 --- /dev/null +++ b/libs/extlib-leftovers/base64.mli @@ -0,0 +1,65 @@ +(* + * Base64 - Base64 codec + * Copyright (C) 2003 Nicolas Cannasse + * + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Lesser General Public + * License as published by the Free Software Foundation; either + * version 2.1 of the License, or (at your option) any later version, + * with the special exception on linking described in file LICENSE. + * + * This library 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 + * Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + *) + +(** Base64 codec. + + 8-bit characters are encoded into 6-bit ones using ASCII lookup tables. + Default tables maps 0..63 values on characters A-Z, a-z, 0-9, '+' and '/' + (in that order). +*) + +open ExtBytes + +(** This exception is raised when reading an invalid character + from a base64 input. *) +exception Invalid_char + +(** This exception is raised if the encoding or decoding table + size is not correct. *) +exception Invalid_table + +(** An encoding table maps integers 0..63 to the corresponding char. *) +type encoding_table = char array + +(** A decoding table maps chars 0..255 to the corresponding 0..63 value + or -1 if the char is not accepted. *) +type decoding_table = int array + +(** erroneous interface, kept for compatibility use [encode_string] instead *) +val str_encode : ?tbl:encoding_table -> string -> Bytes.t + +(** erroneous interface, kept for compatibility use [decode_string] instead *) +val str_decode : ?tbl:decoding_table -> Bytes.t -> string + +(** Encode a string into Base64. *) +val encode_string : ?tbl:encoding_table -> string -> string + +(** Decode a string encoded into Base64, raise [Invalid_char] if a + character in the input string is not a valid one. *) +val decode_string : ?tbl:decoding_table -> string -> string + +(** Generic base64 encoding over an output. *) +val encode : ?tbl:encoding_table -> 'a IO.output -> 'a IO.output + +(** Generic base64 decoding over an input. *) +val decode : ?tbl:decoding_table -> IO.input -> IO.input + +(** Create a valid decoding table from an encoding one. *) +val make_decoding_table : encoding_table -> decoding_table diff --git a/libs/extlib-leftovers/dune b/libs/extlib-leftovers/dune index 8321c4c2..3cbc2bb9 100644 --- a/libs/extlib-leftovers/dune +++ b/libs/extlib-leftovers/dune @@ -3,5 +3,5 @@ (library (name extlib_leftovers) (libraries extlib) - (wrapped false) + ; (wrapped false) ) \ No newline at end of file diff --git a/libs/ilib/ilMetaReader.ml b/libs/ilib/ilMetaReader.ml index ec472a97..24a954cd 100644 --- a/libs/ilib/ilMetaReader.ml +++ b/libs/ilib/ilMetaReader.ml @@ -1556,8 +1556,11 @@ let read_custom_attr ctx attr_type s pos = let pos, cons = read_constant ctx (sig_to_const ilsig) s pos in pos, InstConstant (cons) | SClass c when is_type (["System"],"Type") c -> - let pos, len = read_compressed_i32 s pos in - pos+len, InstType (String.sub s pos len) + if (sget s pos) == 0xff then + pos+1, InstConstant INull + else + let pos, len = read_compressed_i32 s pos in + pos+len, InstType (String.sub s pos len) | SType -> let pos, len = read_compressed_i32 s pos in pos+len, InstType (String.sub s pos len) diff --git a/libs/ilib/peData.ml b/libs/ilib/peData.ml index 0a3881aa..c513c6e7 100644 --- a/libs/ilib/peData.ml +++ b/libs/ilib/peData.ml @@ -52,6 +52,8 @@ type machine_type = | TTriCore (* 0x0520 Infineon *) | TAmd64 (* 0x8664 AMD x64 and Intel E64T *) | TM32R (* 0x9041 M32R *) + | TOSXAmd64 (* 0xC020 = 0x8664 xor 0x4644 OSX AMD x64 *) + | TLinuxAmd64 (* 0xFD1D = 0x8664 xor 0x7B79 Linux AMD x64 *) type coff_prop = | RelocsStripped (* 0x1 *) diff --git a/libs/ilib/peDataDebug.ml b/libs/ilib/peDataDebug.ml index 2c41a51d..4b52c11c 100644 --- a/libs/ilib/peDataDebug.ml +++ b/libs/ilib/peDataDebug.ml @@ -48,6 +48,8 @@ let machine_type_s m = match m with | TTriCore -> "TTriCore" | TAmd64 -> "TAmd64" | TM32R -> "TM32R" + | TOSXAmd64 -> "TOSXAmd64" + | TLinuxAmd64 -> "TLinuxAmd64" let coff_prop_s p = match p with | RelocsStripped -> "RelocsStripped" diff --git a/libs/ilib/peReader.ml b/libs/ilib/peReader.ml index 53703e9d..fc79151e 100644 --- a/libs/ilib/peReader.ml +++ b/libs/ilib/peReader.ml @@ -77,6 +77,8 @@ let machine_type_of_int i = match i with | 0x0520 -> TTriCore (* 0x0520 Infineon *) | 0x8664 -> TAmd64 (* 0x8664 AMD x64 and Intel E64T *) | 0x9041 -> TM32R (* 0x9041 M32R *) + | 0xC020 -> TOSXAmd64 (* 0xC020 OSX AMD x64 *) + | 0xFD1D -> TLinuxAmd64 (* 0xFD1D Linux AMD x64 *) | _ -> assert false let coff_props_of_int iprops = List.fold_left (fun acc i -> diff --git a/libs/ilib/peWriter.ml b/libs/ilib/peWriter.ml index c6f976fb..afc67238 100644 --- a/libs/ilib/peWriter.ml +++ b/libs/ilib/peWriter.ml @@ -59,6 +59,8 @@ let int_of_machine_type t = match t with | TTriCore -> 0x0520 (* 0x0520 Infineon *) | TAmd64 -> 0x8664 (* 0x8664 AMD x64 and Intel E64T *) | TM32R -> 0x9041 (* 0x9041 M32R *) + | TOSXAmd64 -> 0xC020 (* 0xC020 = 0x8664 xor 0x4644 OSX AMD x64 *) + | TLinuxAmd64 -> 0xFD1D (* 0xFD1D = 0x8664 xor 0x7B79 Linux AMD x64 *) let int_of_coff_props props = List.fold_left (fun acc prop -> (match prop with diff --git a/libs/javalib/jData.ml b/libs/javalib/jData.ml index 12f2561e..52c779e2 100644 --- a/libs/javalib/jData.ml +++ b/libs/javalib/jData.ml @@ -89,11 +89,12 @@ type jconstant = (** invokeDynamic-specific *) | ConstMethodHandle of (reference_type * jconstant) (* tag = 15 *) | ConstMethodType of jmethod_signature (* tag = 16 *) + | ConstDynamic of (bootstrap_method * unqualified_name * jsignature) (* tag = 17 *) | ConstInvokeDynamic of (bootstrap_method * unqualified_name * jsignature) (* tag = 18 *) + | ConstModule of unqualified_name (* tag = 19 *) + | ConstPackage of unqualified_name (* tag = 20 *) | ConstUnusable -type jcode = unit (* TODO *) - type jaccess_flag = | JPublic (* 0x0001 *) | JPrivate (* 0x0002 *) @@ -112,6 +113,7 @@ type jaccess_flag = | JInterface (* 0x0200 *) | JAbstract (* 0x0400 *) | JAnnotation (* 0x2000 *) + | JModule (* 0x8000 *) (** method flags *) | JBridge (* 0x0040 *) | JVarArgs (* 0x0080 *) @@ -135,12 +137,24 @@ and jannotation_value = | ValAnnotation of jannotation (* @ *) | ValArray of jannotation_value list (* [ *) +type jlocal = { + ld_start_pc : int; + ld_length : int; + ld_name : string; + ld_descriptor : string; + ld_index : int; +} + type jattribute = | AttrDeprecated | AttrVisibleAnnotations of jannotation list | AttrInvisibleAnnotations of jannotation list + | AttrLocalVariableTable of jlocal list + | AttrMethodParameters of (string * int) list | AttrUnknown of string * string +type jcode = jattribute list (* TODO *) + type jfield_kind = | JKField | JKMethod @@ -195,7 +209,10 @@ type jconstant_raw = | KUtf8String of string (* 1 *) | KMethodHandle of (reference_type * dynref) (* 15 *) | KMethodType of utf8ref (* 16 *) + | KDynamic of (bootstrapref * nametyperef) (* 17 *) | KInvokeDynamic of (bootstrapref * nametyperef) (* 18 *) + | KModule of utf8ref (* 19 *) + | KPackage of utf8ref (* 20 *) | KUnusable (* jData debugging *) diff --git a/libs/javalib/jReader.ml b/libs/javalib/jReader.ml index b5ea1e43..6fe08f7e 100644 --- a/libs/javalib/jReader.ml +++ b/libs/javalib/jReader.ml @@ -87,10 +87,18 @@ let parse_constant max idx ch = KMethodHandle (reft, dynref) | 16 -> KMethodType (index()) + | 17 -> + let bootstrapref = read_ui16 ch in (* not index *) + let nametyperef = index() in + KDynamic (bootstrapref, nametyperef) | 18 -> let bootstrapref = read_ui16 ch in (* not index *) let nametyperef = index() in KInvokeDynamic (bootstrapref, nametyperef) + | 19 -> + KModule (index()) + | 20 -> + KPackage (index()) | n -> error() @@ -328,9 +336,16 @@ let rec expand_constant consts i = ConstMethodHandle (reference_type, expand_constant consts dynref) | KMethodType utf8ref -> ConstMethodType (parse_method_signature (expand_string utf8ref)) + | KDynamic(bootstrapref, nametyperef) -> + let n, t = expand_nametype nametyperef in + ConstDynamic(bootstrapref, n, t) | KInvokeDynamic (bootstrapref, nametyperef) -> let n, t = expand_nametype nametyperef in ConstInvokeDynamic(bootstrapref, n, t) + | KModule n -> + ConstModule (expand_string n) + | KPackage n -> + ConstPackage (expand_string n) | KUnusable -> ConstUnusable @@ -416,6 +431,31 @@ let parse_attribute on_special consts ch = | "Deprecated" -> if alen <> 0 then error(); Some (AttrDeprecated) + | "LocalVariableTable" -> + let len = read_ui16 ch in + let locals = List.init len (fun _ -> + let start_pc = read_ui16 ch in + let length = read_ui16 ch in + let name = get_string consts ch in + let descriptor = get_string consts ch in + let index = read_ui16 ch in + { + ld_start_pc = start_pc; + ld_length = length; + ld_name = name; + ld_descriptor = descriptor; + ld_index = index + } + ) in + Some (AttrLocalVariableTable locals) + | "MethodParameters" -> + let len = IO.read_byte ch in + let parameters = List.init len (fun _ -> + let name = get_string consts ch in + let flags = read_ui16 ch in + (name,flags) + ) in + Some (AttrMethodParameters parameters) | "RuntimeVisibleAnnotations" -> let anncount = read_ui16 ch in Some (AttrVisibleAnnotations (List.init anncount (fun _ -> parse_annotation consts ch))) @@ -469,8 +509,19 @@ let parse_field kind consts ch = let s = get_string consts ch in jsig := parse_signature s; None - | JKMethod, "Code" -> (* TODO *) - do_default() + | JKMethod, "Code" -> + ignore(read_ui16 ch); (* max stack *) + ignore(read_ui16 ch); (* max locals *) + let len = read_i32 ch in + ignore(IO.nread_string ch len); (* code *) + let len = read_ui16 ch in + for i = 0 to len - 1 do + ignore(IO.nread_string ch 8); + done; (* exceptions *) + let attrib_count = read_ui16 ch in + let attribs = parse_attributes consts ch attrib_count in + code := Some attribs; + None | JKMethod, "Exceptions" -> let num = read_ui16 ch in throws := List.init num (fun _ -> TObject(get_class consts ch,[])); @@ -515,7 +566,7 @@ let parse_class ch = c ) in let consts = Array.mapi (fun i _ -> expand_constant consts i) consts in - let flags = parse_access_flags ch [JPublic; JUnusable; JUnusable; JUnusable; JFinal; JSuper; JUnusable; JUnusable; JUnusable; JInterface; JAbstract; JUnusable; JSynthetic; JAnnotation; JEnum] in + let flags = parse_access_flags ch [JPublic; JUnusable; JUnusable; JUnusable; JFinal; JSuper; JUnusable; JUnusable; JUnusable; JInterface; JAbstract; JUnusable; JSynthetic; JAnnotation; JEnum; JModule] in let this = get_class consts ch in let super_idx = read_ui16 ch in let super = match super_idx with diff --git a/libs/javalib/jWriter.ml b/libs/javalib/jWriter.ml index 2288854c..6218d199 100644 --- a/libs/javalib/jWriter.ml +++ b/libs/javalib/jWriter.ml @@ -197,10 +197,20 @@ let rec const ctx c = | ConstMethodType jmethod_signature (* tag = 16 *) -> write_byte ctx.cpool 16; write_ui16 ctx.cpool (const ctx (ConstUtf8 (encode_sig ctx (TMethod jmethod_signature)))) + | ConstDynamic (bootstrap_method, unqualified_name, jsignature) (* tag = 17 *) -> + write_byte ctx.cpool 17; + write_ui16 ctx.cpool bootstrap_method; + write_ui16 ctx.cpool (const ctx (ConstNameAndType(unqualified_name, jsignature))) | ConstInvokeDynamic (bootstrap_method, unqualified_name, jsignature) (* tag = 18 *) -> write_byte ctx.cpool 18; write_ui16 ctx.cpool bootstrap_method; write_ui16 ctx.cpool (const ctx (ConstNameAndType(unqualified_name, jsignature))) + | ConstModule unqualified_name (* tag = 19 *) -> + write_byte ctx.cpool 19; + write_ui16 ctx.cpool (const ctx (ConstUtf8 (unqualified_name))); + | ConstPackage unqualified_name (* tag = 20 *) -> + write_byte ctx.cpool 20; + write_ui16 ctx.cpool (const ctx (ConstUtf8 (unqualified_name))); | ConstUnusable -> assert false); ctx.ccount <- ret + 1; ret diff --git a/libs/swflib/as3.mli b/libs/swflib/as3.mli index 283f3ab9..8786fac1 100644 --- a/libs/swflib/as3.mli +++ b/libs/swflib/as3.mli @@ -16,6 +16,7 @@ * along with this program; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA *) +open Extlib_leftovers type 'a index type 'a index_nz diff --git a/libs/swflib/as3code.ml b/libs/swflib/as3code.ml index 02e8e7fc..c701da7f 100644 --- a/libs/swflib/as3code.ml +++ b/libs/swflib/as3code.ml @@ -16,6 +16,7 @@ * along with this program; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA *) +open Extlib_leftovers open IO open As3 diff --git a/libs/swflib/as3hl.mli b/libs/swflib/as3hl.mli index 8d6ee2d7..6e37901d 100644 --- a/libs/swflib/as3hl.mli +++ b/libs/swflib/as3hl.mli @@ -16,6 +16,7 @@ * along with this program; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA *) +open Extlib_leftovers open As3 type hl_ident = string diff --git a/libs/swflib/as3hlparse.ml b/libs/swflib/as3hlparse.ml index 52312d53..3a39db20 100644 --- a/libs/swflib/as3hlparse.ml +++ b/libs/swflib/as3hlparse.ml @@ -16,6 +16,7 @@ * along with this program; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA *) +open Extlib_leftovers open As3 open As3hl diff --git a/libs/swflib/as3parse.ml b/libs/swflib/as3parse.ml index cdb04202..05dac41e 100644 --- a/libs/swflib/as3parse.ml +++ b/libs/swflib/as3parse.ml @@ -16,6 +16,7 @@ * along with this program; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA *) +open Extlib_leftovers open As3 let parse_idents = true diff --git a/libs/ttflib/tTFTools.ml b/libs/ttflib/tTFTools.ml index e3dade3e..d9bf568e 100644 --- a/libs/ttflib/tTFTools.ml +++ b/libs/ttflib/tTFTools.ml @@ -19,7 +19,7 @@ * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER * DEALINGS IN THE SOFTWARE. *) - +open Extlib_leftovers open TTFData type glyf_transformation_matrix = { diff --git a/opam b/opam index f6f5a104..5b2be5cf 100644 --- a/opam +++ b/opam @@ -1,6 +1,6 @@ opam-version: "2.0" name: "haxe" -version: "4.1.5" +version: "4.2.0" synopsis: "Multi-target universal programming language" description: """ Haxe is an open source toolkit based on a modern, @@ -22,7 +22,7 @@ depends: [ "ocaml" {>= "4.02"} "ocamlfind" {build} "dune" {>= "1.11"} - "camlp5" {build} + "camlp5" {build & = "8.00~alpha05"} "sedlex" {>= "2.0"} "xml-light" "extlib" {>= "1.7.6"} @@ -32,4 +32,5 @@ depends: [ "conf-zlib" "conf-mbedtls" "conf-neko" + "luv" ] \ No newline at end of file diff --git a/src-json/define.json b/src-json/define.json index 0d10f248..7a753d6d 100644 --- a/src-json/define.json +++ b/src-json/define.json @@ -46,7 +46,8 @@ "name": "CsVer", "define": "cs_ver", "doc": "The C# version to target.", - "platforms": ["cs"] + "platforms": ["cs"], + "params": ["version"] }, { "name": "NoCppiaAst", @@ -114,7 +115,8 @@ { "name": "DumpPath", "define": "dump_path", - "doc": "Path to generate dumps to (default: \"dump\")." + "doc": "Path to generate dumps to (default: \"dump\").", + "params": ["path"] }, { "name": "DumpDependencies", @@ -231,12 +233,14 @@ { "name": "HaxeVer", "define": "haxe_ver", - "doc": "The current Haxe version value as decimal number. E.g. 3.407 for 3.4.7." + "doc": "The current Haxe version value as decimal number. E.g. 3.407 for 3.4.7.", + "reserved": true }, { "name": "Haxe", "define": "haxe", - "doc": "The current Haxe version value in SemVer format." + "doc": "The current Haxe version value in SemVer format.", + "reserved": true }, { "name": "HlVer", @@ -249,7 +253,8 @@ "name": "HxcppApiLevel", "define": "hxcpp_api_level", "doc": "Provided to allow compatibility between hxcpp versions.", - "platforms": ["cpp"] + "platforms": ["cpp"], + "reserved": true }, { "name": "HxcppGcGenerational", @@ -280,6 +285,12 @@ "define": "interp", "doc": "The code is compiled to be run with `--interp`." }, + { + "name": "JarLegacyLoader", + "define": "jar-legacy-loader", + "doc": "Use the legacy loader to load .jar files on the JVM target.", + "platforms": ["java"] + }, { "name": "JavaVer", "define": "java_ver", @@ -298,7 +309,7 @@ "define": "js_es", "doc": "Generate JS compliant with given ES standard version. (default: 5)", "platforms": ["js"], - "params": ["version number"], + "params": ["version: 3 | 5 | 6"], "links": ["https://haxe.org/manual/target-javascript-es6.html"] }, { @@ -331,6 +342,18 @@ "doc": "Generate jvm directly.", "platforms": ["java"] }, + { + "name": "JvmCompressionLevel", + "define": "jvm.compression-level", + "doc": "Set the compression level of the generated file between 0 (no compression) and 9 (highest compression). Default: 6", + "platforms": ["java"] + }, + { + "name": "JvmDynamicLevel", + "define": "jvm.dynamic-level", + "doc": "Controls the amount of dynamic support code being generated. 0 = none, 1 = field read/write optimization (default), 2 = compile-time method closures", + "platforms": ["java"] + }, { "name": "KeepOldOutput", "define": "keep_old_output", @@ -366,7 +389,8 @@ "name": "Macro", "define": "macro", "doc": "Defined when code is compiled in the macro context.", - "links": ["https://haxe.org/manual/macro.html"] + "links": ["https://haxe.org/manual/macro.html"], + "reserved": true }, { "name": "MacroTimes", @@ -418,11 +442,6 @@ "doc": "Disable final compilation.", "platforms": ["cs", "java", "cpp", "hl"] }, - { - "name": "NoCOpt", - "define": "no_copt", - "doc": "Disable completion optimization (for debug purposes)." - }, { "name": "NoDebug", "define": "no_debug", @@ -484,11 +503,6 @@ "doc": "Sets the hxcpp output to Objective-C++ classes. Must be defined for interop.", "platforms": ["cpp"] }, - { - "name": "OldConstructorInline", - "define": "old-constructor-inline", - "doc": "Use old constructor inlining logic (from Haxe 3.4.2) instead of the reworked version." - }, { "name": "OldErrorFormat", "define": "old-error-format", @@ -560,7 +574,8 @@ { "name": "Static", "define": "static", - "doc": "Defined if the current target is static." + "doc": "Defined if the current target is static.", + "reserved": true }, { "name": "StdEncodingUtf8", @@ -572,7 +587,8 @@ "name": "Swc", "define": "swc", "doc": "Output a SWC instead of a SWF.", - "platforms": ["flash"] + "platforms": ["flash"], + "reserved": true }, { "name": "SwfCompressLevel", @@ -635,7 +651,8 @@ { "name": "Sys", "define": "sys", - "doc": "Defined for all system platforms." + "doc": "Defined for all system platforms.", + "reserved": true }, { "name": "Unsafe", @@ -652,7 +669,8 @@ { "name": "Utf16", "define": "utf16", - "doc": "Defined for all platforms that use UTF-16 string encoding with UCS-2 API." + "doc": "Defined for all platforms that use UTF-16 string encoding with UCS-2 API.", + "reserved": true }, { "name": "Vcproj", diff --git a/src-json/meta.json b/src-json/meta.json index 208c6e71..5a049e5b 100644 --- a/src-json/meta.json +++ b/src-json/meta.json @@ -394,6 +394,12 @@ "targets": ["TAbstract"], "links": ["https://haxe.org/manual/types-abstract-forward.html"] }, + { + "name": "ForwardNew", + "metadata": ":forward.new", + "doc": "Forwards constructor call to underlying type.", + "targets": ["TAbstract"] + }, { "name": "ForwardStatics", "metadata": ":forwardStatics", @@ -402,6 +408,12 @@ "targets": ["TAbstract"], "links": ["https://haxe.org/manual/types-abstract-forward.html"] }, + { + "name": "ForwardVariance", + "metadata": ":forward.variance", + "doc": "Forwards variance unification to underlying type.", + "targets": ["TAbstract"] + }, { "name": "From", "metadata": ":from", @@ -520,13 +532,6 @@ "targets": ["TClassField"], "links": ["https://haxe.org/manual/cr-dce.html"] }, - { - "name": "Impl", - "metadata": ":impl", - "doc": "Used internally to mark abstract implementation fields.", - "targets": ["TAbstractField"], - "internal": true - }, { "name": "PythonImport", "metadata": ":pythonImport", @@ -554,6 +559,12 @@ "doc": "", "platforms": ["cpp"] }, + { + "name": "InheritDoc", + "metadata": ":inheritDoc", + "doc": "Append documentation from a parent field or class (if used without an argument) or from a specified class or field (if used like @:inheritDoc(pack.Some.field)).", + "targets": ["TClass", "TClass", "TEnum", "TAbstract", "TAnyField"] + }, { "name": "InitPackage", "metadata": ":initPackage", @@ -573,6 +584,12 @@ "doc": "Internally used to mark expressions that were passed as arguments of an inlined constructor.", "internal": true }, + { + "name": "InlineObject", + "metadata": ":inlineObject", + "doc": "Internally used by inline constructors filter to mark potentially inlineable objects.", + "internal": true + }, { "name": "Internal", "metadata": ":internal", @@ -781,7 +798,7 @@ { "name": "NoDoc", "metadata": ":noDoc", - "doc": "Prevents a type from being included in documentation generation." + "doc": "Prevents a type or field from being included in documentation generation." }, { "name": "NoExpr", @@ -1000,12 +1017,6 @@ "targets": ["TClassField"], "links": ["https://haxe.org/manual/lf-condition-compilation.html"] }, - { - "name": "RequiresAssign", - "metadata": ":requiresAssign", - "doc": "Used internally to mark certain abstract operator overloads.", - "internal": true - }, { "name": "Resolve", "metadata": ":resolve", @@ -1190,6 +1201,12 @@ "platforms": ["java"], "targets": ["TClassField"] }, + { + "name": "Transitive", + "metadata": ":transitive", + "doc": "Allows transitive casts with an abstract.", + "targets": ["TAbstract"] + }, { "name": "ValueUsed", "metadata": ":valueUsed", diff --git a/src/codegen/codegen.ml b/src/codegen/codegen.ml index 8a26b757..303b6251 100644 --- a/src/codegen/codegen.ml +++ b/src/codegen/codegen.ml @@ -22,6 +22,7 @@ open Type open Common open Error open Globals +open Extlib_leftovers (* -------------------------------------------------------------------------- *) (* TOOLS *) @@ -75,6 +76,7 @@ let escape_res_name name allow_dirs = "-x" ^ (string_of_int (Char.code chr))) name let update_cache_dependencies t = + let visited_anons = ref [] in let rec check_t m t = match t with | TInst(c,tl) -> add_dependency m c.cl_module; @@ -92,7 +94,10 @@ let update_cache_dependencies t = List.iter (fun (_,_,t) -> check_t m t) targs; check_t m tret; | TAnon an -> - PMap.iter (fun _ cf -> check_field m cf) an.a_fields + if not (List.memq an !visited_anons) then begin + visited_anons := an :: !visited_anons; + PMap.iter (fun _ cf -> check_field m cf) an.a_fields + end | TMono r -> (match r.tm_type with | Some t -> check_t m t @@ -193,7 +198,7 @@ let fix_override com c f fd = let fde = (match f.cf_expr with None -> die "" __LOC__ | Some e -> e) in f.cf_expr <- Some { fde with eexpr = TFunction fd2 }; f.cf_type <- TFun(targs,tret); - | Some(f2), None when c.cl_interface -> + | Some(f2), None when (has_class_flag c CInterface) -> let targs, tret = (match follow f2.cf_type with TFun (args,ret) -> args, ret | _ -> die "" __LOC__) in f.cf_type <- TFun(targs,tret) | _ -> @@ -203,7 +208,7 @@ let fix_overrides com t = match t with | TClassDecl c -> (* overrides can be removed from interfaces *) - if c.cl_interface then + if (has_class_flag c CInterface) then c.cl_ordered_fields <- List.filter (fun f -> try if find_field com c f == f then raise Not_found; @@ -216,7 +221,7 @@ let fix_overrides com t = match f.cf_expr, f.cf_kind with | Some { eexpr = TFunction fd }, Method (MethNormal | MethInline) -> fix_override com c f (Some fd) - | None, Method (MethNormal | MethInline) when c.cl_interface -> + | None, Method (MethNormal | MethInline) when (has_class_flag c CInterface) -> fix_override com c f None | _ -> () @@ -230,7 +235,7 @@ let fix_overrides com t = *) let fix_abstract_inheritance com t = match t with - | TClassDecl c when c.cl_interface -> + | TClassDecl c when (has_class_flag c CInterface) -> c.cl_ordered_fields <- List.filter (fun f -> let b = try (find_field com c f) == f with Not_found -> false in @@ -278,7 +283,10 @@ module Dump = struct let dump_types com s_expr = let s_type = s_type (Type.print_context()) in - let params tl = match tl with [] -> "" | l -> Printf.sprintf "<%s>" (String.concat "," (List.map (fun (n,t) -> n ^ " : " ^ s_type t) l)) in + let params tl = match tl with + | [] -> "" + | l -> Printf.sprintf "<%s>" (String.concat ", " (List.map Printer.s_type_param l)) + in List.iter (fun mt -> let path = Type.t_path mt in let buf,close = create_dumpfile_from_path com path in @@ -301,7 +309,7 @@ module Dump = struct let rec print_field stat f = print "\n\t%s%s%s%s%s %s%s" (s_metas f.cf_meta "\t") - (if (has_class_field_flag f CfPublic && not (c.cl_extern || c.cl_interface)) then "public " else "") + (if (has_class_field_flag f CfPublic && not ((has_class_flag c CExtern) || (has_class_flag c CInterface))) then "public " else "") (if stat then "static " else "") (match f.cf_kind with | Var v when (is_inline_var f.cf_kind) -> "inline " @@ -324,7 +332,7 @@ module Dump = struct (match f.cf_expr with | None -> "" | Some e -> " = " ^ (s_cf_expr f)); - | Method m -> if (c.cl_extern || c.cl_interface) then ( + | Method m -> if ((has_class_flag c CExtern) || (has_class_flag c CInterface)) then ( match f.cf_type with | TFun(al,t) -> print "(%s):%s;" (String.concat ", " ( List.map (fun (n,o,t) -> n ^ ":" ^ (s_type t)) al)) @@ -334,7 +342,7 @@ module Dump = struct print "\n"; List.iter (fun f -> print_field stat f) f.cf_overloads in - print "%s%s%s%s %s%s" (s_metas c.cl_meta "") (if c.cl_private then "private " else "") (if c.cl_extern then "extern " else "") (if c.cl_interface then "interface" else "class") (s_type_path path) (params c.cl_params); + print "%s%s%s%s %s%s" (s_metas c.cl_meta "") (if c.cl_private then "private " else "") (if (has_class_flag c CExtern) then "extern " else "") (if (has_class_flag c CInterface) then "interface" else "class") (s_type_path path) (params c.cl_params); (match c.cl_super with None -> () | Some (c,pl) -> print " extends %s" (s_type (TInst (c,pl)))); List.iter (fun (c,pl) -> print " implements %s" (s_type (TInst (c,pl)))) c.cl_implements; (match c.cl_array_access with None -> () | Some t -> print " implements ArrayAccess<%s>" (s_type t)); @@ -425,11 +433,12 @@ module Dump = struct let print fmt = Printf.kprintf (fun s -> Buffer.add_string buf s) fmt in let dep = Hashtbl.create 0 in List.iter (fun m -> - print "%s:\n" m.m_extra.m_file; + print "%s:\n" (Path.UniqueKey.lazy_path m.m_extra.m_file); PMap.iter (fun _ m2 -> - print "\t%s\n" (m2.m_extra.m_file); - let l = try Hashtbl.find dep m2.m_extra.m_file with Not_found -> [] in - Hashtbl.replace dep m2.m_extra.m_file (m :: l) + let file = Path.UniqueKey.lazy_path m2.m_extra.m_file in + print "\t%s\n" file; + let l = try Hashtbl.find dep file with Not_found -> [] in + Hashtbl.replace dep file (m :: l) ) m.m_extra.m_deps; ) com.Common.modules; close(); @@ -439,7 +448,7 @@ module Dump = struct Hashtbl.iter (fun n ml -> print "%s:\n" n; List.iter (fun m -> - print "\t%s\n" (m.m_extra.m_file); + print "\t%s\n" (Path.UniqueKey.lazy_path m.m_extra.m_file); ) ml; ) dep; close() @@ -479,8 +488,6 @@ let default_cast ?(vtmp="$t") com e texpr t p = mk (TBlock [var;check;vexpr]) t p module UnificationCallback = struct - let tf_stack = new_rec_stack() - let check_call_params f el tl = let rec loop acc el tl = match el,tl with | e :: el, (n,_,t) :: tl -> @@ -499,66 +506,6 @@ module UnificationCallback = struct check_call_params f el args | _ -> List.map (fun e -> f e t_dynamic) el - - let rec run ff e = - let f e t = - if not (type_iseq e.etype t) then - ff e t - else - e - in - let check e = match e.eexpr with - | TBinop((OpAssign | OpAssignOp _),e1,e2) -> - die "" __LOC__; (* this trigger #4347, to be fixed before enabling - let e2 = f e2 e1.etype in - {e with eexpr = TBinop(op,e1,e2)} *) - | TVar(v,Some ev) -> - let eo = Some (f ev v.v_type) in - { e with eexpr = TVar(v,eo) } - | TCall(e1,el) -> - let el = check_call f el e1.etype in - {e with eexpr = TCall(e1,el)} - | TNew(c,tl,el) -> - begin try - let tcf,_ = get_constructor (fun cf -> apply_params c.cl_params tl cf.cf_type) c in - let el = check_call f el tcf in - {e with eexpr = TNew(c,tl,el)} - with Not_found -> - e - end - | TArrayDecl el -> - begin match follow e.etype with - | TInst({cl_path=[],"Array"},[t]) -> {e with eexpr = TArrayDecl(List.map (fun e -> f e t) el)} - | _ -> e - end - | TObjectDecl fl -> - begin match follow e.etype with - | TAnon an -> - let fl = List.map (fun ((n,p,qs),e) -> - let e = try - let t = (PMap.find n an.a_fields).cf_type in - f e t - with Not_found -> - e - in - (n,p,qs),e - ) fl in - { e with eexpr = TObjectDecl fl } - | _ -> e - end - | TReturn (Some e1) -> - begin match tf_stack.rec_stack with - | tf :: _ -> { e with eexpr = TReturn (Some (f e1 tf.tf_type))} - | _ -> e - end - | _ -> - e - in - match e.eexpr with - | TFunction tf -> - rec_stack_loop tf_stack tf (fun() -> {e with eexpr = TFunction({tf with tf_expr = run f tf.tf_expr})}) () - | _ -> - check (Type.map_expr (run ff) e) end;; let interpolate_code com code tl f_string f_expr p = diff --git a/src/codegen/dotnet.ml b/src/codegen/dotnet.ml index c0e919ce..bdf141db 100644 --- a/src/codegen/dotnet.ml +++ b/src/codegen/dotnet.ml @@ -377,7 +377,7 @@ let convert_ilevent ctx p ev = cff_kind = kind; } -let convert_ilmethod ctx p m is_explicit_impl = +let convert_ilmethod ctx p is_interface m is_explicit_impl = if not (Common.defined ctx.ncom Define.Unsafe) && has_unmanaged m.msig.snorm then raise Exit; let force_check = Common.defined ctx.ncom Define.ForceLibCheck in let p = { p with pfile = p.pfile ^" (" ^m.mname ^")" } in @@ -394,13 +394,10 @@ let convert_ilmethod ctx p m is_explicit_impl = | _ -> name) | name -> name in - let meta = [Meta.Overload, [], p] in + let meta = [] in let acc, meta = match m.mflags.mf_access with | FAFamily | FAFamOrAssem -> (APrivate,null_pos), ((Meta.Protected, [], p) :: meta) - (* | FAPrivate -> APrivate *) - | FAPublic when List.mem SGetter m.msemantics || List.mem SSetter m.msemantics -> - (APrivate,null_pos), meta | FAPublic -> (APublic,null_pos), meta | _ -> if PMap.mem "net_loader_debug" ctx.ncom.defines.Define.values then @@ -414,6 +411,7 @@ let convert_ilmethod ctx p m is_explicit_impl = | CMFinal -> acc, Some true | _ -> acc, is_final ) ([acc],None) m.mflags.mf_contract in + let acc = (AOverload,p) :: acc in if PMap.mem "net_loader_debug" ctx.ncom.defines.Define.values then Printf.printf "\t%smethod %s : %s\n" (if !is_static then "static " else "") cff_name (IlMetaDebug.ilsig_s m.msig.ssig); @@ -494,7 +492,8 @@ let convert_ilmethod ctx p m is_explicit_impl = cff_name, meta in let acc = match m.moverride with - | None -> acc + | None -> + if not is_interface && List.mem IAbstract m.mflags.mf_impl then (AAbstract,null_pos) :: acc else acc | _ when cff_name = "new" -> acc | Some (path,s) -> match lookup_ilclass ctx.nstd ctx.ncom path with | Some ilcls when not (List.mem SInterface ilcls.cflags.tdf_semantics) -> @@ -729,16 +728,24 @@ let convert_ilclass ctx p ?(delegate=false) ilcls = match ilcls.csuper with meta := (Meta.LibType,[],p) :: !meta; let is_interface = ref false in + let is_abstract = ref false in + let is_sealed = ref false in List.iter (fun f -> match f with | SSealed -> - flags := HFinal :: !flags + flags := HFinal :: !flags; + is_sealed := true | SInterface -> is_interface := true; flags := HInterface :: !flags - | SAbstract -> meta := (Meta.Abstract, [], p) :: !meta + | SAbstract -> + meta := (Meta.Abstract, [], p) :: !meta; + is_abstract := true; | _ -> () ) ilcls.cflags.tdf_semantics; + (* static class = abstract sealed class - in this case we don't want an abstract flag *) + if !is_abstract && not !is_interface && not !is_sealed then flags := HAbstract :: !flags; + (* (match ilcls.cflags.tdf_vis with *) (* | VPublic | VNestedFamOrAssem | VNestedFamily -> () *) (* | _ -> raise Exit); *) @@ -796,7 +803,7 @@ let convert_ilclass ctx p ?(delegate=false) ilcls = match ilcls.csuper with ilcls.cmethods in run_fields (fun m -> - convert_ilmethod ctx p m (List.exists (fun m2 -> m != m2 && String.get m2.mname 0 <> '.' && String.ends_with m2.mname ("." ^ m.mname)) meths) + convert_ilmethod ctx p !is_interface m (List.exists (fun m2 -> m != m2 && String.get m2.mname 0 <> '.' && String.ends_with m2.mname ("." ^ m.mname)) meths) ) meths; run_fields (convert_ilfield ctx p) ilcls.cfields; run_fields (fun prop -> @@ -986,7 +993,11 @@ let normalize_ilcls ctx cls = let rec loop cls = try match cls.csuper with | Some { snorm = LClass((["System"],[],"Object"),_) } - | Some { snorm = LObject } | None -> () + | Some { snorm = LObject } -> + let cls, params = ilcls_from_ilsig ctx LObject in + let cls = ilcls_with_params ctx cls params in + all_fields := get_all_fields cls @ !all_fields; + | None -> () | Some s -> let cls, params = ilcls_from_ilsig ctx s.snorm in let cls = ilcls_with_params ctx cls params in @@ -1043,7 +1054,7 @@ let normalize_ilcls ctx cls = List.iter (loop_interface cif) cif.cimplements with | Not_found -> () in - List.iter (loop_interface cls) cls.cimplements; + if not (List.mem SAbstract cls.cflags.tdf_semantics) then List.iter (loop_interface cls) cls.cimplements; let added = List.map (function | (IlMethod m,a,name,b) when m.mflags.mf_access <> FAPublic -> (IlMethod { m with mflags = { m.mflags with mf_access = FAPublic } },a,name,b) @@ -1236,7 +1247,7 @@ let before_generate com = let net_ver = try let ver = PMap.find "net_ver" com.defines.Define.values in - try int_of_string ver with Failure _ -> raise (Arg.Bad "Invalid value for -D net-ver. Expected format: xx (e.g. 20, 35, 40, 45)") + try int_of_string ver with Failure _ -> raise (Arg.Bad "Invalid value for -D net-ver. Expected format: xx (e.g. 20, 35, 40, 45, 50)") with Not_found when netcore_ver != None -> (* 4.7 was released around .NET core 2.1 *) (* Note: better version mapping should be implemented some day, @@ -1259,7 +1270,7 @@ let before_generate com = loop acc | _ -> () in - loop [20;21;30;35;40;45]; + loop [20;21;30;35;40;45;50]; (* net target *) let net_target = try diff --git a/src/codegen/gencommon/abstractImplementationFix.ml b/src/codegen/gencommon/abstractImplementationFix.ml index b27949f0..6009026d 100644 --- a/src/codegen/gencommon/abstractImplementationFix.ml +++ b/src/codegen/gencommon/abstractImplementationFix.ml @@ -26,7 +26,7 @@ let add_abstract_params = function function | ({ cf_name = "_new" } as cf) -> cf.cf_params <- cf.cf_params @ a.a_params - | cf when Meta.has Meta.Impl cf.cf_meta -> + | cf when has_class_field_flag cf CfImpl -> (match cf.cf_expr with | Some({ eexpr = TFunction({ tf_args = (v, _) :: _ }) }) when Meta.has Meta.This v.v_meta -> cf.cf_params <- cf.cf_params @ a.a_params diff --git a/src/codegen/gencommon/castDetect.ml b/src/codegen/gencommon/castDetect.ml index f4634a64..3de4432f 100644 --- a/src/codegen/gencommon/castDetect.ml +++ b/src/codegen/gencommon/castDetect.ml @@ -199,15 +199,11 @@ let rec type_eq gen param a b = Unify_error l -> Type.error (invalid_field n :: l) with Not_found -> - if is_closed a2 then Type.error [has_no_field b n]; - if not (link (Monomorph.create()) b f1.cf_type) then Type.error [cannot_unify a b]; - a2.a_fields <- PMap.add n f1 a2.a_fields + Type.error [has_no_field b n]; ) a1.a_fields; PMap.iter (fun n f2 -> if not (PMap.mem n a1.a_fields) then begin - if is_closed a1 then Type.error [has_no_field a n]; - if not (link (Monomorph.create()) a f2.cf_type) then Type.error [cannot_unify a b]; - a1.a_fields <- PMap.add n f2 a1.a_fields + Type.error [has_no_field a n]; end; ) a2.a_fields; with @@ -547,8 +543,11 @@ let select_overload gen applied_f overloads types params = let rec check_arg arglist elist = match arglist, elist with | [], [] -> true (* it is valid *) - | (_,_,TAbstract({ a_path = (["haxe";"extern"],"Rest") }, [t])) :: [], elist -> + | (_,_,t) :: [], elist when ExtType.is_rest t -> + (match follow t with + | TAbstract({ a_path = (["haxe"],"Rest") }, [t]) -> List.for_all (fun (_,_,et) -> Type.type_iseq (clean_t et) (clean_t t)) elist + | _ -> die "" __LOC__) | (_,_,t) :: arglist, (_,_,et) :: elist when Type.type_iseq (clean_t et) (clean_t t) -> check_arg arglist elist | _ -> false @@ -619,19 +618,39 @@ let choose_ctor gen cl tparams etl maybe_empty_t p = ret, !count > 1 | _ -> let len = List.length etl in - let ret = List.filter (fun cf -> List.length (fst (get_fun cf.cf_type)) = len) ctors in + let ret = List.filter (fun cf -> List.length (fst (get_fun cf.cf_type)) <= len) ctors in ret, (match ret with | _ :: [] -> false | _ -> true) in let rec check_arg arglist elist = match arglist, elist with | [], [] -> true - | (_,_,t) :: arglist, et :: elist -> (try - let t = run_follow gen t in - unify et t; - check_arg arglist elist - with | Unify_error el -> - (* List.iter (fun el -> gen.gcon.warning (Error.unify_error_msg (print_context()) el) p) el; *) - false) + | [(_,_,t)], elist when ExtType.is_rest (follow t) -> + let is_rest_array arg_t = + Type.fast_eq (Abstract.follow_with_abstracts t) (Abstract.follow_with_abstracts arg_t) + in + (match elist with + | [arg_t] when is_rest_array arg_t -> true + | _ -> + match follow t with + | TAbstract ({ a_path = ["haxe"],"Rest" }, [t1]) -> + let t1 = run_follow gen t1 in + (try + List.iter (fun et -> unify et t1) elist; + true + with Unify_error _ -> + false + ) + | _ -> die "" __LOC__ + ) + | (_,_,t) :: arglist, et :: elist -> + (try + let t = run_follow gen t in + unify et t; + check_arg arglist elist + with Unify_error el -> + (* List.iter (fun el -> gen.gcon.warning (Error.unify_error_msg (print_context()) el) p) el; *) + false + ) | _ -> false in @@ -649,8 +668,22 @@ let choose_ctor gen cl tparams etl maybe_empty_t p = let change_rest tfun elist = let rec loop acc arglist elist = match arglist, elist with - | (_,_,TAbstract({ a_path = (["haxe";"extern"],"Rest") },[t])) :: [], elist -> - List.rev (List.map (fun _ -> "rest",false,t) elist @ acc) + | (_,_,t) as arg :: [], elist when ExtType.is_rest t -> + (match elist with + | [{ eexpr = TUnop (Spread,Prefix,e) }] -> + List.rev (arg :: acc) + | _ -> + (match follow t with + | TAbstract({ a_path = (["haxe"],"Rest") },[t1]) -> + let is_rest_array e = + Type.fast_eq (Abstract.follow_with_abstracts t) (Abstract.follow_with_abstracts e.etype) + in + (match elist with + | [e] when is_rest_array e -> List.rev (("rest",false,t) :: acc) + | _ -> List.rev (List.map (fun _ -> "rest",false,t1) elist @ acc) + ) + | _ -> die "" __LOC__) + ) | (n,o,t) :: arglist, _ :: elist -> loop ((n,o,t) :: acc) arglist elist | _, _ -> @@ -762,7 +795,7 @@ let handle_type_parameter gen e e1 ef ~clean_ef ~overloads_cast_to_base f elist let ecall = get e in let ef = ref ef in - let is_overload = cf.cf_overloads <> [] || Meta.has Meta.Overload cf.cf_meta || (is_static && is_static_overload cl (field_name f)) in + let is_overload = cf.cf_overloads <> [] || has_class_field_flag cf CfOverload || (is_static && is_static_overload cl (field_name f)) in let cf, actual_t, error = match is_overload with | false -> (* since actual_t from FClassField already applies greal_type, we're using the get_overloads helper to get this info *) @@ -779,7 +812,7 @@ let handle_type_parameter gen e e1 ef ~clean_ef ~overloads_cast_to_base f elist (* FIXME: this is a workaround for issue #1743 . Uncomment this code after it was solved *) (* let t, cf = List.find (fun (t,cf2) -> cf == cf2) (Overloads.get_overloads cl (field_name f)) in *) (* cf, t, false *) - select_overload gen e1.etype (Overloads.get_overloads cl (field_name f)) cl.cl_params params, false + select_overload gen e1.etype (Overloads.collect_overloads (fun t -> t) cl (field_name f)) cl.cl_params params, false | FStatic(c,f) -> (* workaround for issue #1743 *) (* f,f.cf_type, false *) @@ -1122,10 +1155,10 @@ let configure gen ?(overloads_cast_to_base = false) maybe_empty_t calls_paramete handle e t1 t2 in let stl = gen.greal_type_param (TClassDecl sup) stl in - let args, _ = get_fun (apply_params sup.cl_params stl cf.cf_type) in + let args,rt = get_fun (apply_params sup.cl_params stl cf.cf_type) in let eparams = List.map2 (fun e (_,_,t) -> handle (run e) t e.etype - ) eparams args in + ) (wrap_rest_args gen (TFun (args,rt)) eparams e.epos) args in { e with eexpr = TCall(ef, eparams) } with | Not_found -> gen.gcon.warning "No overload found for this constructor call" e.epos; @@ -1150,10 +1183,10 @@ let configure gen ?(overloads_cast_to_base = false) maybe_empty_t calls_paramete handle e t1 t2 in let stl = gen.greal_type_param (TClassDecl sup) stl in - let args, _ = get_fun (apply_params sup.cl_params stl cf.cf_type) in + let args,rt = get_fun (apply_params sup.cl_params stl cf.cf_type) in let eparams = List.map2 (fun e (_,_,t) -> handle (run e) t e.etype - ) eparams args in + ) (wrap_rest_args gen (TFun (args,rt)) eparams e.epos) args in { e with eexpr = TNew(cl, tparams, eparams) } with | Not_found -> gen.gcon.warning "No overload found for this constructor call" e.epos; diff --git a/src/codegen/gencommon/closuresToClass.ml b/src/codegen/gencommon/closuresToClass.ml index 3d332d3f..98b3fc9a 100644 --- a/src/codegen/gencommon/closuresToClass.ml +++ b/src/codegen/gencommon/closuresToClass.ml @@ -119,11 +119,11 @@ let mk_conversion_fun gen e = in let block, local = match e.eexpr with | TLocal v -> - v.v_capture <- true; + add_var_flag v VCaptured; [],e | _ -> let tmp = mk_temp "delegate_conv" e.etype in - tmp.v_capture <- true; + add_var_flag tmp VCaptured; [{ eexpr = TVar(tmp,Some e); etype = gen.gcon.basic.tvoid; epos = e.epos }], mk_local tmp e.epos in let body = { @@ -191,29 +191,29 @@ let traverse gen ?tparam_anon_decl ?tparam_anon_acc (handle_anon_func:texpr->tfu | None -> Type.map_expr run e | Some tparam_anon_decl -> (match (vv, ve) with - | ({ v_extra = Some( _ :: _, _) } as v), Some ({ eexpr = TFunction tf } as f) - | ({ v_extra = Some( _ :: _, _) } as v), Some { eexpr = TArrayDecl([{ eexpr = TFunction tf } as f]) | TCall({ eexpr = TIdent "__array__" }, [{ eexpr = TFunction tf } as f]) } -> (* captured transformation *) + | ({ v_extra = Some({v_params = _ :: _}) } as v), Some ({ eexpr = TFunction tf } as f) + | ({ v_extra = Some({v_params = _ :: _}) } as v), Some { eexpr = TArrayDecl([{ eexpr = TFunction tf } as f]) | TCall({ eexpr = TIdent "__array__" }, [{ eexpr = TFunction tf } as f]) } -> (* captured transformation *) tparam_anon_decl v f { tf with tf_expr = run tf.tf_expr }; { e with eexpr = TBlock([]) } | _ -> Type.map_expr run { e with eexpr = TVar(vv, ve) }) ) - | TBinop(OpAssign, { eexpr = TLocal({ v_extra = Some(_ :: _, _) } as v)}, ({ eexpr= TFunction tf } as f)) when is_some tparam_anon_decl -> + | TBinop(OpAssign, { eexpr = TLocal({ v_extra = Some({v_params = _ :: _}) } as v)}, ({ eexpr= TFunction tf } as f)) when is_some tparam_anon_decl -> (match tparam_anon_decl with | None -> die "" __LOC__ | Some tparam_anon_decl -> tparam_anon_decl v f { tf with tf_expr = run tf.tf_expr }; { e with eexpr = TBlock([]) } ) - | TLocal ({ v_extra = Some( _ :: _, _) } as v) -> + | TLocal ({ v_extra = Some({v_params = _ :: _}) } as v) -> (match tparam_anon_acc with | None -> Type.map_expr run e | Some tparam_anon_acc -> tparam_anon_acc v e false) - | TArray ( ({ eexpr = TLocal ({ v_extra = Some( _ :: _, _) } as v) } as expr), _) -> (* captured transformation *) + | TArray ( ({ eexpr = TLocal ({ v_extra = Some({v_params = _ :: _}) } as v) } as expr), _) -> (* captured transformation *) (match tparam_anon_acc with | None -> Type.map_expr run e | Some tparam_anon_acc -> tparam_anon_acc v { expr with etype = e.etype } false) - | TMeta((Meta.Custom ":tparamcall",_,_),({ eexpr=TLocal ({ v_extra = Some( _ :: _, _) } as v) } as expr)) -> + | TMeta((Meta.Custom ":tparamcall",_,_),({ eexpr=TLocal ({ v_extra = Some({v_params = _ :: _}) } as v) } as expr)) -> (match tparam_anon_acc with | None -> Type.map_expr run e | Some tparam_anon_acc -> tparam_anon_acc v expr true) @@ -334,14 +334,14 @@ let get_captured expr = Type.iter traverse expr | TVar (v, opt) -> (match v.v_extra with - | Some(_ :: _, _) -> () + | Some({v_params = _ :: _}) -> () | _ -> check_params v.v_type); Hashtbl.add ignored v.v_id v; ignore(Option.map traverse opt) - | TLocal { v_extra = Some( (_ :: _ ),_) } -> + | TLocal { v_extra = Some({v_params = (_ :: _ )}) } -> () - | TLocal(( { v_capture = true } ) as v) -> + | TLocal v when has_var_flag v VCaptured -> (if not (Hashtbl.mem ignored v.v_id || Hashtbl.mem ret v.v_id) then begin check_params v.v_type; Hashtbl.replace ret v.v_id expr end); | _ -> Type.iter traverse expr in traverse expr; @@ -454,7 +454,7 @@ let configure gen ft = (* change all captured variables to this.capturedVariable *) let rec change_captured e = match e.eexpr with - | TLocal( ({ v_capture = true }) as v ) when Hashtbl.mem captured_ht v.v_id -> + | TLocal v when has_var_flag v VCaptured && Hashtbl.mem captured_ht v.v_id -> mk_this v e.epos | _ -> Type.map_expr change_captured e in @@ -524,11 +524,11 @@ let configure gen ft = (* add invoke function to the class *) cls.cl_ordered_fields <- invoke_field :: cls.cl_ordered_fields; cls.cl_fields <- PMap.add invoke_field.cf_name invoke_field cls.cl_fields; - cls.cl_overrides <- invoke_field :: cls.cl_overrides; + add_class_field_flag invoke_field CfOverride; (match tvar with | None -> () - | Some ({ v_extra = Some(_ :: _, _) } as v) -> + | Some ({ v_extra = Some({v_params = _ :: _}) } as v) -> Hashtbl.add tvar_to_cdecl v.v_id (cls,captured) | _ -> ()); @@ -596,7 +596,7 @@ let configure gen ft = | _ -> die "" __LOC__) captured in let types = match v.v_extra with - | Some(t,_) -> t + | Some ve -> ve.v_params | _ -> die "" __LOC__ in let monos = List.map (fun _ -> mk_mono()) types in @@ -653,7 +653,6 @@ let configure gen ft = in gen.gexpr_filters#add name (PCustom priority) run - (* this submodule will provide the default implementation for the C# and Java targets. @@ -853,7 +852,7 @@ struct let dynamic_fun_call call_expr = let tc, params = match call_expr.eexpr with - | TCall(tc, params) -> tc, params + | TCall(tc, params) -> tc,wrap_rest_args gen tc.etype params tc.epos | _ -> die "" __LOC__ in let ct = gen.greal_type call_expr.etype in diff --git a/src/codegen/gencommon/enumToClass.ml b/src/codegen/gencommon/enumToClass.ml index f45ae939..5814a920 100644 --- a/src/codegen/gencommon/enumToClass.ml +++ b/src/codegen/gencommon/enumToClass.ml @@ -92,7 +92,7 @@ struct let super, has_params = if Meta.has Meta.FlatEnum en.e_meta then base_class, false else base_param_class, true in cl.cl_super <- Some(super,[]); - cl.cl_extern <- en.e_extern; + if en.e_extern then add_class_flag cl CExtern; en.e_meta <- (Meta.Class, [], pos) :: en.e_meta; cl.cl_module <- en.e_module; cl.cl_meta <- ( Meta.Enum, [], pos ) :: cl.cl_meta; @@ -204,7 +204,7 @@ struct cl.cl_ordered_fields <- getTag_cf :: cl.cl_ordered_fields ; cl.cl_fields <- PMap.add "getTag" getTag_cf cl.cl_fields; - cl.cl_overrides <- getTag_cf :: cl.cl_overrides; + add_class_field_flag getTag_cf CfOverride; cl.cl_meta <- (Meta.NativeGen,[],cl.cl_pos) :: cl.cl_meta; gen.gadd_to_module (TClassDecl cl) (max_dep); diff --git a/src/codegen/gencommon/enumToClass2.ml b/src/codegen/gencommon/enumToClass2.ml index 8321c6af..d30cccde 100644 --- a/src/codegen/gencommon/enumToClass2.ml +++ b/src/codegen/gencommon/enumToClass2.ml @@ -30,7 +30,7 @@ let add_static c cf = let add_field c cf override = c.cl_fields <- PMap.add cf.cf_name cf c.cl_fields; c.cl_ordered_fields <- cf :: c.cl_ordered_fields; - if override then c.cl_overrides <- cf :: c.cl_overrides + if override then add_class_field_flag cf CfOverride let add_meta com en cl_enum = Option.may (fun expr -> @@ -54,7 +54,7 @@ module EnumToClass2Modf = struct (* create the class *) let cl_enum = mk_class en.e_module en.e_path pos in cl_enum.cl_super <- Some (base_class,[]); - cl_enum.cl_extern <- en.e_extern; + if en.e_extern then add_class_flag cl_enum CExtern; cl_enum.cl_meta <- [(Meta.Enum,[],pos); (Meta.NativeGen,[],pos)] @ cl_enum.cl_meta; (* mark the enum that it's generated as a class *) @@ -94,7 +94,7 @@ module EnumToClass2Modf = struct let pos = ef.ef_pos in let cl_ctor = mk_class en.e_module (e_pack, e_name ^ "_" ^ name) pos in - cl_ctor.cl_final <- true; + add_class_flag cl_ctor CFinal; cl_ctor.cl_super <- Some (cl_enum, []); cl_ctor.cl_meta <- [ (Meta.Enum,[],pos); diff --git a/src/codegen/gencommon/fixOverrides.ml b/src/codegen/gencommon/fixOverrides.ml index 18734d31..f79195a5 100644 --- a/src/codegen/gencommon/fixOverrides.ml +++ b/src/codegen/gencommon/fixOverrides.ml @@ -47,11 +47,11 @@ let priority = solve_deps name [] let run ~explicit_fn_name ~get_vmtype gen = let implement_explicitly = is_some explicit_fn_name in let run md = match md with - | TClassDecl ( { cl_interface = true; cl_extern = false } as c ) -> + | TClassDecl c when (has_class_flag c CInterface) && not (has_class_flag c CExtern) -> (* overrides can be removed from interfaces *) c.cl_ordered_fields <- List.filter (fun f -> try - if Meta.has Meta.Overload f.cf_meta then raise Not_found; + if has_class_field_flag f CfOverload then raise Not_found; let f2 = Codegen.find_field gen.gcon c f in if f2 == f then raise Not_found; c.cl_fields <- PMap.remove f.cf_name c.cl_fields; @@ -60,7 +60,7 @@ let run ~explicit_fn_name ~get_vmtype gen = true ) c.cl_ordered_fields; md - | TClassDecl({ cl_extern = false } as c) -> + | TClassDecl c when not (has_class_flag c CExtern) -> let this = { eexpr = TConst TThis; etype = TInst(c,List.map snd c.cl_params); epos = c.cl_pos } in (* look through all interfaces, and try to find a type that applies exactly *) let rec loop_iface (iface:tclass) itl = @@ -71,11 +71,11 @@ let run ~explicit_fn_name ~get_vmtype gen = let ftype = apply_params iface.cl_params itl f.cf_type in let real_ftype = get_real_fun gen (apply_params iface.cl_params real_itl f.cf_type) in replace_mono real_ftype; - let overloads = Overloads.get_overloads c f.cf_name in + let overloads = Overloads.collect_overloads (fun t -> t) c f.cf_name in try let t2, f2 = match overloads with - | (_, cf) :: _ when Meta.has Meta.Overload cf.cf_meta -> (* overloaded function *) + | (_, cf) :: _ when has_class_field_flag cf CfOverload -> (* overloaded function *) (* try to find exact function *) List.find (fun (t,f2) -> Overloads.same_overload_args ~get_vmtype ftype t f f2 @@ -163,7 +163,7 @@ let run ~explicit_fn_name ~get_vmtype gen = (* now go through all overrides, *) let rec check_f f = (* find the first declared field *) - let is_overload = Meta.has Meta.Overload f.cf_meta in + let is_overload = has_class_field_flag f CfOverload in let decl = if is_overload then find_first_declared_field gen c ~get_vmtype ~exact_field:f f.cf_name else @@ -203,9 +203,9 @@ let run ~explicit_fn_name ~get_vmtype gen = with Unify_error _ -> false) current_args original_args | _ -> Globals.die "" __LOC__ in - if (not (Meta.has Meta.Overload f.cf_meta) && has_contravariant_args) then - f.cf_meta <- (Meta.Overload, [], f.cf_pos) :: f.cf_meta; - if Meta.has Meta.Overload f.cf_meta then begin + if (not (has_class_field_flag f CfOverload) && has_contravariant_args) then + add_class_field_flag f CfOverload; + if has_class_field_flag f CfOverload then begin (* if it is overload, create another field with the requested type *) let f3 = mk_class_field f.cf_name t (has_class_field_flag f CfPublic) f.cf_pos f.cf_kind f.cf_params in let p = f.cf_pos in @@ -254,8 +254,14 @@ let run ~explicit_fn_name ~get_vmtype gen = | _ -> f) | _ -> f in - if not c.cl_extern then - c.cl_overrides <- List.map (fun f -> check_f f) c.cl_overrides; + if not (has_class_flag c CExtern) then + List.iter (fun f -> + if has_class_field_flag f CfOverride then begin + remove_class_field_flag f CfOverride; + let f2 = check_f f in + add_class_field_flag f2 CfOverride + end + ) c.cl_ordered_fields; md | _ -> md in diff --git a/src/codegen/gencommon/gencommon.ml b/src/codegen/gencommon/gencommon.ml index 50b9f22d..e647b48b 100644 --- a/src/codegen/gencommon/gencommon.ml +++ b/src/codegen/gencommon/gencommon.ml @@ -620,11 +620,11 @@ let new_ctx con = gadd_type = (fun md should_filter -> if should_filter then begin gen.gtypes_list <- md :: gen.gtypes_list; - gen.gmodules <- { m_id = alloc_mid(); m_path = (t_path md); m_types = [md]; m_extra = module_extra "" "" 0. MFake [] } :: gen.gmodules; + gen.gmodules <- { m_id = alloc_mid(); m_path = (t_path md); m_types = [md]; m_statics = None; m_extra = module_extra "" "" 0. MFake [] } :: gen.gmodules; Hashtbl.add gen.gtypes (t_path md) md; end else gen.gafter_filters_ended <- (fun () -> gen.gtypes_list <- md :: gen.gtypes_list; - gen.gmodules <- { m_id = alloc_mid(); m_path = (t_path md); m_types = [md]; m_extra = module_extra "" "" 0. MFake [] } :: gen.gmodules; + gen.gmodules <- { m_id = alloc_mid(); m_path = (t_path md); m_types = [md]; m_statics = None; m_extra = module_extra "" "" 0. MFake [] } :: gen.gmodules; Hashtbl.add gen.gtypes (t_path md) md; ) :: gen.gafter_filters_ended; ); @@ -685,7 +685,7 @@ let reorder_modules gen = Hashtbl.iter (fun md_path md -> if not (Hashtbl.mem processed md_path) then begin Hashtbl.add processed md_path true; - gen.gmodules <- { m_id = alloc_mid(); m_path = md_path; m_types = List.rev ( Hashtbl.find_all modules md_path ); m_extra = (t_infos md).mt_module.m_extra } :: gen.gmodules + gen.gmodules <- { m_id = alloc_mid(); m_path = md_path; m_types = List.rev ( Hashtbl.find_all modules md_path ); m_statics = None; m_extra = (t_infos md).mt_module.m_extra } :: gen.gmodules end ) modules @@ -839,12 +839,12 @@ let write_file gen w source_dir path extension out_files = close_out f end; - out_files := (Path.UniqueKey.create s_path) :: !out_files; + out_files := (gen.gcon.file_keys#get s_path) :: !out_files; t() -let clean_files path excludes verbose = +let clean_files gen path excludes verbose = let rec iter_files pack dir path = try let file = Unix.readdir dir in @@ -854,7 +854,7 @@ let clean_files path excludes verbose = let pack = pack @ [file] in iter_files (pack) (Unix.opendir filepath) filepath; try Unix.rmdir filepath with Unix.Unix_error (ENOTEMPTY,_,_) -> (); - else if not (String.ends_with filepath ".meta") && not (List.mem (Path.UniqueKey.create filepath) excludes) then begin + else if not (String.ends_with filepath ".meta") && not (List.mem (gen.gcon.file_keys#get filepath) excludes) then begin if verbose then print_endline ("Removing " ^ filepath); Sys.remove filepath end @@ -902,7 +902,7 @@ let dump_descriptor gen name path_s module_s = SourceWriter.newline w; List.iter (fun m -> match m with - | TClassDecl cl when not cl.cl_extern -> + | TClassDecl cl when not (has_class_flag cl CExtern) -> SourceWriter.write w "C "; let s = module_s m in Hashtbl.add main_paths cl.cl_path s; @@ -996,6 +996,42 @@ let get_real_fun gen t = let mk_nativearray_decl gen t el pos = mk (TCall (mk (TIdent "__array__") t_dynamic pos, el)) (gen.gclasses.nativearray t) pos + +(** + Wraps rest arguments into a native array. + E.g. transforms params from `callee(param, rest1, rest2, ..., restN)` into + `callee(param, untyped __array__(rest1, rest2, ..., restN))` +*) +let wrap_rest_args gen callee_type params p = + match follow callee_type with + | TFun(args, _) -> + let rec loop args params = + match args, params with + (* last argument expects rest parameters *) + | [(_,_,t)], params when ExtType.is_rest (follow t) -> + (match params with + (* In case of `...rest` just use `rest` *) + | [{ eexpr = TUnop(Spread,Prefix,e) }] -> [e] + (* In other cases: `untyped __array__(param1, param2, ...)` *) + | _ -> + match Abstract.follow_with_abstracts t with + | TInst ({ cl_path = _,"NativeArray" }, [t1]) -> + let pos = punion_el (List.map (fun e -> ((),e.epos)) params) in + let t1 = if Common.defined gen.gcon Define.EraseGenerics then t_dynamic else t1 in + [mk_nativearray_decl gen t1 params pos] + | _ -> + die ~p "Unexpected rest arguments type" __LOC__ + ) + | a :: args, e :: params -> + e :: loop args params + | [], params -> + params + | _ :: _, [] -> + [] + in + loop args params + | _ -> params + let ensure_local com block name e = match e.eexpr with | TLocal _ -> e @@ -1043,30 +1079,6 @@ let mt_to_t_dyn md = | TAbstractDecl a -> TAbstract(a, List.map (fun _ -> t_dynamic) a.a_params) | TTypeDecl t -> TType(t, List.map (fun _ -> t_dynamic) t.t_params) -let mt_to_t mt params = - match mt with - | TClassDecl (cl) -> TInst(cl, params) - | TEnumDecl (e) -> TEnum(e, params) - | TAbstractDecl a -> TAbstract(a, params) - | _ -> die "" __LOC__ - -let t_to_mt t = - match follow t with - | TInst(cl, _) -> TClassDecl(cl) - | TEnum(e, _) -> TEnumDecl(e) - | TAbstract(a, _) -> TAbstractDecl a - | _ -> die "" __LOC__ - -let rec get_last_ctor cl = - Option.map_default (fun (super,_) -> if is_some super.cl_constructor then Some(get super.cl_constructor) else get_last_ctor super) None cl.cl_super - -let add_constructor cl cf = - match cl.cl_constructor with - | None -> cl.cl_constructor <- Some cf - | Some ctor -> - if ctor != cf && not (List.memq cf ctor.cf_overloads) then - ctor.cf_overloads <- cf :: ctor.cf_overloads - (* replace open TMonos with TDynamic *) let rec replace_mono t = match t with @@ -1125,7 +1137,7 @@ let find_first_declared_field gen orig_cl ?get_vmtype ?exact_field field = let rec loop_cl depth c tl tlch = (try let ret = PMap.find field c.cl_fields in - if Meta.has Meta.Overload ret.cf_meta then is_overload := true; + if has_class_field_flag ret CfOverload then is_overload := true; match !chosen, exact_field with | Some(d,f,_,_,_), _ when depth <= d || (is_var ret && not (is_var f)) -> () | _, None -> @@ -1144,7 +1156,7 @@ let find_first_declared_field gen orig_cl ?get_vmtype ?exact_field field = let tlch = List.map (apply_params c.cl_params tlch) stl in loop_cl (depth+1) sup tl tlch | None -> ()); - if c.cl_interface then + if (has_class_flag c CInterface) then List.iter (fun (sup,stl) -> let tl = List.map (apply_params c.cl_params tl) stl in let stl = gen.greal_type_param (TClassDecl sup) stl in @@ -1157,8 +1169,8 @@ let find_first_declared_field gen orig_cl ?get_vmtype ?exact_field field = | None -> None | Some(_,f,c,tl,tlch) -> - if !is_overload && not (Meta.has Meta.Overload f.cf_meta) then - f.cf_meta <- (Meta.Overload,[],f.cf_pos) :: f.cf_meta; + if !is_overload && not (has_class_field_flag f CfOverload) then + add_class_field_flag f CfOverload; let declared_t = apply_params c.cl_params tl f.cf_type in let params_t = apply_params c.cl_params tlch f.cf_type in let actual_t = match follow params_t with diff --git a/src/codegen/gencommon/initFunction.ml b/src/codegen/gencommon/initFunction.ml index 653404af..c31b6165 100644 --- a/src/codegen/gencommon/initFunction.ml +++ b/src/codegen/gencommon/initFunction.ml @@ -49,7 +49,7 @@ let ensure_simple_expr com e = let handle_override_dynfun acc e this field = let v = mk_temp ("super_" ^ field) e.etype in - v.v_capture <- true; + add_var_flag v VCaptured; let add_expr = ref None in @@ -126,7 +126,7 @@ let handle_class com cl = let var = mk (TField ((mk (TConst TThis) (TInst (cl, List.map snd cl.cl_params)) cf.cf_pos), FInstance(cl, List.map snd cl.cl_params, cf))) cf.cf_type cf.cf_pos in let ret = binop Ast.OpAssign var e cf.cf_type cf.cf_pos in cf.cf_expr <- None; - let is_override = List.memq cf cl.cl_overrides in + let is_override = has_class_field_flag cf CfOverride in if is_override then begin cl.cl_ordered_fields <- List.filter (fun f -> f.cf_name <> cf.cf_name) cl.cl_ordered_fields; @@ -146,7 +146,7 @@ let handle_class com cl = let ret = binop Ast.OpAssign var (change_expr e) (fn cf.cf_type) cf.cf_pos in cf.cf_expr <- None; - let is_override = List.memq cf cl.cl_overrides in + let is_override = has_class_field_flag cf CfOverride in if is_override then begin cl.cl_ordered_fields <- List.filter (fun f -> f.cf_name <> cf.cf_name) cl.cl_ordered_fields; @@ -226,7 +226,7 @@ let handle_class com cl = let mod_filter com md = match md with - | TClassDecl cl when not cl.cl_extern -> + | TClassDecl cl when not (has_class_flag cl CExtern) -> handle_class com cl | _ -> () diff --git a/src/codegen/gencommon/interfaceProps.ml b/src/codegen/gencommon/interfaceProps.ml index 7d92d745..095730fd 100644 --- a/src/codegen/gencommon/interfaceProps.ml +++ b/src/codegen/gencommon/interfaceProps.ml @@ -24,7 +24,7 @@ open Type If they are, it will add Meta.Property to it. *) let run = function - | TClassDecl ({ cl_interface = false; cl_extern = false } as cl) -> + | TClassDecl cl when not (has_class_flag cl CInterface) && not (has_class_flag cl CExtern) -> let vars = List.fold_left (fun acc (iface,_) -> if Meta.has Meta.CsNative iface.cl_meta then let props = List.filter (fun cf -> match cf.cf_kind with Var { v_read = AccCall } | Var { v_write = AccCall } -> true | _ -> false) iface.cl_ordered_fields in diff --git a/src/codegen/gencommon/interfaceVarsDeleteModf.ml b/src/codegen/gencommon/interfaceVarsDeleteModf.ml index ea067f75..dd93cc5a 100644 --- a/src/codegen/gencommon/interfaceVarsDeleteModf.ml +++ b/src/codegen/gencommon/interfaceVarsDeleteModf.ml @@ -39,7 +39,7 @@ let priority = solve_deps name [] let configure gen = let run md = match md with - | TClassDecl ({ cl_interface = true } as cl) -> + | TClassDecl cl when (has_class_flag cl CInterface) -> let to_add = ref [] in let fields = List.filter (fun cf -> match cf.cf_kind with diff --git a/src/codegen/gencommon/normalize.ml b/src/codegen/gencommon/normalize.ml index 9616d966..2758423e 100644 --- a/src/codegen/gencommon/normalize.ml +++ b/src/codegen/gencommon/normalize.ml @@ -39,13 +39,15 @@ let rec filter_param (stack:t list) t = | Some t -> filter_param stack t) | TInst(_,[]) | TEnum(_,[]) | TAbstract(_,[]) -> t + | TType({ t_path = (["haxe";"extern"],"Rest") },_) -> + filter_param stack (follow t) | TType(td,tl) -> TType(td,List.map (filter_param stack) tl) | TInst(c,tl) -> TInst(c,List.map (filter_param stack) tl) | TEnum(e,tl) -> TEnum(e,List.map (filter_param stack) tl) - | TAbstract({ a_path = (["haxe";"extern"],"Rest") } as a,tl) -> + | TAbstract({ a_path = (["haxe"],"Rest") } as a,tl) -> TAbstract(a, List.map (filter_param stack) tl) | TAbstract({a_path = [],"Null"} as a,[t]) -> TAbstract(a,[filter_param stack t]) diff --git a/src/codegen/gencommon/overloadingConstructor.ml b/src/codegen/gencommon/overloadingConstructor.ml index 178191d3..aa754f4c 100644 --- a/src/codegen/gencommon/overloadingConstructor.ml +++ b/src/codegen/gencommon/overloadingConstructor.ml @@ -125,7 +125,7 @@ let create_static_ctor com ~empty_ctor_expr cl ctor follow_type = | _ -> ()) | _ -> ()) ctor_types; let me = alloc_var "__hx_this" (TInst(cl, List.map snd ctor_types)) in - me.v_capture <- true; + add_var_flag me VCaptured; let fn_args, _ = get_fun ctor.cf_type in let ctor_params = List.map snd ctor_types in @@ -140,13 +140,13 @@ let create_static_ctor com ~empty_ctor_expr cl ctor follow_type = let local_map = Hashtbl.create (List.length cur_tf_args) in let static_tf_args = (me, None) :: List.map (fun (v,b) -> let new_v = alloc_var v.v_name (apply_params cl.cl_params ctor_params v.v_type) in - new_v.v_capture <- v.v_capture; + add_var_flag new_v VCaptured; Hashtbl.add local_map v.v_id new_v; (new_v, b) ) cur_tf_args in let static_ctor = mk_class_field ~static:true static_ctor_name fn_type false ctor.cf_pos (Method MethNormal) ctor_types in - let static_ctor_meta = if cl.cl_final then Meta.Private else Meta.Protected in + let static_ctor_meta = if has_class_flag cl CFinal then Meta.Private else Meta.Protected in static_ctor.cf_meta <- (static_ctor_meta,[],ctor.cf_pos) :: static_ctor.cf_meta; (* change ctor contents to reference the 'me' var instead of 'this' *) @@ -260,7 +260,7 @@ let clone_ctors com ctor sup stl cl = Globals.die "" __LOC__ (* should never happen *) | cf :: [] -> cf | cf :: overl -> - cf.cf_meta <- (Meta.Overload,[],cf.cf_pos) :: cf.cf_meta; + add_class_field_flag cf CfOverload; cf.cf_overloads <- overl; cf let rec descends_from_native_or_skipctor cl = @@ -284,7 +284,7 @@ let ensure_super_is_first com cf = let init com (empty_ctor_type : t) (empty_ctor_expr : texpr) (follow_type : t -> t) = let basic = com.basic in - let should_change cl = not cl.cl_interface && (not cl.cl_extern || is_hxgen (TClassDecl cl)) && (match cl.cl_kind with KAbstractImpl _ -> false | _ -> true) in + let should_change cl = not (has_class_flag cl CInterface) && (not (has_class_flag cl CExtern) || is_hxgen (TClassDecl cl)) && (match cl.cl_kind with KAbstractImpl _ | KModuleFields _ -> false | _ -> true) in let msize = List.length com.types in let processed, empty_ctors = Hashtbl.create msize, Hashtbl.create msize in diff --git a/src/codegen/gencommon/realTypeParams.ml b/src/codegen/gencommon/realTypeParams.ml index 43bf5126..26a259e0 100644 --- a/src/codegen/gencommon/realTypeParams.ml +++ b/src/codegen/gencommon/realTypeParams.ml @@ -400,7 +400,7 @@ struct let this = { eexpr = TConst TThis; etype = (TInst(cl, List.map snd cl.cl_params)); epos = p } in let rec loop curcls params level reverse_params = - if (level <> 0 || curcls.cl_interface) && params <> [] && is_hxgeneric (TClassDecl curcls) then begin + if (level <> 0 || (has_class_flag curcls CInterface) || (has_class_flag curcls CAbstract) ) && params <> [] && is_hxgeneric (TClassDecl curcls) then begin let cparams = List.map (fun (s,t) -> (s, TInst (map_param (get_cl_t t), []))) curcls.cl_params in let name = get_cast_name curcls in if not (PMap.mem name cl.cl_fields) then begin @@ -430,7 +430,7 @@ struct gen.gafter_filters_ended <- delay :: gen.gafter_filters_ended; (* do not let filters alter this expression content *) cl.cl_ordered_fields <- cfield :: cl.cl_ordered_fields; cl.cl_fields <- PMap.add cfield.cf_name cfield cl.cl_fields; - if level <> 0 then cl.cl_overrides <- cfield :: cl.cl_overrides + if level <> 0 then add_class_field_flag cfield CfOverride end end; let get_reverse super supertl = @@ -666,7 +666,7 @@ struct | TClassDecl ({ cl_params = hd :: tl } as cl) when set_hxgeneric gen md -> let iface = mk_class cl.cl_module cl.cl_path cl.cl_pos in iface.cl_array_access <- Option.map (apply_params (cl.cl_params) (List.map (fun _ -> t_dynamic) cl.cl_params)) cl.cl_array_access; - iface.cl_extern <- cl.cl_extern; + if (has_class_flag cl CExtern) then add_class_flag iface CExtern; iface.cl_module <- cl.cl_module; iface.cl_private <- cl.cl_private; iface.cl_meta <- @@ -678,12 +678,12 @@ struct Hashtbl.add ifaces cl.cl_path iface; iface.cl_implements <- (base_generic, []) :: iface.cl_implements; - iface.cl_interface <- true; + add_class_flag iface CInterface; cl.cl_implements <- (iface, []) :: cl.cl_implements; let name = get_cast_name cl in let cast_cf = create_cast_cfield gen cl name in - if not cl.cl_interface then create_stub_casts gen cl cast_cf; + if not (has_class_flag cl CInterface) then create_stub_casts gen cl cast_cf; let rec loop c = match c.cl_super with | None -> () @@ -695,7 +695,7 @@ struct in loop cl; - (if not cl.cl_interface then cl.cl_ordered_fields <- cast_cf :: cl.cl_ordered_fields); + (if not (has_class_flag cl CInterface) && not (has_class_flag cl CAbstract) then cl.cl_ordered_fields <- cast_cf :: cl.cl_ordered_fields); let iface_cf = mk_class_field name cast_cf.cf_type false cast_cf.cf_pos (Method MethNormal) cast_cf.cf_params in let cast_static_cf, delay = create_static_cast_cf gen iface iface_cf in @@ -707,9 +707,10 @@ struct iface.cl_fields <- PMap.add name iface_cf iface.cl_fields; let fields = List.filter (fun cf -> match cf.cf_kind with | Var _ | Method MethDynamic -> false + | Method _ when has_class_field_flag cf CfAbstract -> false | _ -> - let is_override = List.memq cf cl.cl_overrides in - let cf_type = if is_override && not (Meta.has Meta.Overload cf.cf_meta) then + let is_override = has_class_field_flag cf CfOverride in + let cf_type = if is_override && not (has_class_field_flag cf CfOverload) then match find_first_declared_field gen cl cf.cf_name with | Some(_,_,declared_t,_,_,_,_) -> declared_t | _ -> Globals.die "" __LOC__ @@ -721,7 +722,7 @@ struct ) cl.cl_ordered_fields in let fields = List.map (fun f -> mk_class_field f.cf_name f.cf_type (has_class_field_flag f CfPublic) f.cf_pos f.cf_kind f.cf_params) fields in - let fields = iface_cf :: fields in + let fields = if has_class_flag cl CAbstract then fields else iface_cf :: fields in iface.cl_ordered_fields <- fields; List.iter (fun f -> iface.cl_fields <- PMap.add f.cf_name f iface.cl_fields) fields; diff --git a/src/codegen/gencommon/reflectionCFs.ml b/src/codegen/gencommon/reflectionCFs.ml index f855b573..5135860d 100644 --- a/src/codegen/gencommon/reflectionCFs.ml +++ b/src/codegen/gencommon/reflectionCFs.ml @@ -777,7 +777,7 @@ let implement_final_lookup ctx cl = cl.cl_ordered_fields <- cl.cl_ordered_fields @ cfs; List.iter (fun cf -> cl.cl_fields <- PMap.add cf.cf_name cf cl.cl_fields; - if is_override then cl.cl_overrides <- cf :: cl.cl_overrides + if is_override then add_class_field_flag cf CfOverride ) cfs in if not is_override then begin @@ -1028,7 +1028,7 @@ let implement_get_set ctx cl = cl.cl_ordered_fields <- cl.cl_ordered_fields @ [cfield]; cl.cl_fields <- PMap.add fun_name cfield cl.cl_fields; - (if is_override then cl.cl_overrides <- cfield :: cl.cl_overrides) + (if is_override then add_class_field_flag cfield CfOverride) end else () in mk_cfield true true; @@ -1065,7 +1065,7 @@ let implement_getFields ctx cl = List.map (fun (_,cf) -> match cf.cf_kind with | Var _ - | Method MethDynamic when not (List.memq cf cl.cl_overrides) -> + | Method MethDynamic when not (has_class_field_flag cf CfOverride) -> has_value := true; mk_push (make_string gen.gcon.basic cf.cf_name pos) | _ -> null basic.tvoid pos @@ -1100,7 +1100,7 @@ let implement_getFields ctx cl = if !has_value || not (is_override cl) then begin cl.cl_ordered_fields <- cl.cl_ordered_fields @ [cf]; cl.cl_fields <- PMap.add cf.cf_name cf cl.cl_fields; - (if is_override cl then cl.cl_overrides <- cf :: cl.cl_overrides) + (if is_override cl then add_class_field_flag cf CfOverride) end @@ -1194,7 +1194,7 @@ let implement_invokeField ctx slow_invoke cl = in let cfs = List.filter (fun (_,cf) -> match cf.cf_kind with - | Method _ -> if List.memq cf cl.cl_overrides then false else true + | Method _ -> if has_class_field_flag cf CfOverride then false else true | _ -> true) cfs in @@ -1244,7 +1244,7 @@ let implement_invokeField ctx slow_invoke cl = let nonstatics = List.filter (fun (n,cf) -> - let is_old = not (PMap.mem cf.cf_name cl.cl_fields) || List.memq cf cl.cl_overrides in + let is_old = not (PMap.mem cf.cf_name cl.cl_fields) || has_class_field_flag cf CfOverride in (if is_old then old_nonstatics := cf :: !old_nonstatics); not is_old ) nonstatics @@ -1267,7 +1267,7 @@ let implement_invokeField ctx slow_invoke cl = if !is_override && not (!has_method) then () else begin cl.cl_ordered_fields <- cl.cl_ordered_fields @ [dyn_fun]; cl.cl_fields <- PMap.add dyn_fun.cf_name dyn_fun cl.cl_fields; - (if !is_override then cl.cl_overrides <- dyn_fun :: cl.cl_overrides) + (if !is_override then add_class_field_flag dyn_fun CfOverride) end let implement_varargs_cl ctx cl = @@ -1322,7 +1322,7 @@ let implement_varargs_cl ctx cl = ) all_cfs; List.iter (fun cf -> - cl.cl_overrides <- cf :: cl.cl_overrides + add_class_field_flag cf CfOverride ) cl.cl_ordered_fields let implement_closure_cl ctx cl = @@ -1380,7 +1380,7 @@ let implement_closure_cl ctx cl = let all_cfs = List.filter (fun cf -> cf.cf_name <> "new" && match cf.cf_kind with Method _ -> true | _ -> false) (ctx.rcf_ft.map_base_classfields cl map_fn) in List.iter (fun cf -> - cl.cl_overrides <- cf :: cl.cl_overrides + add_class_field_flag cf CfOverride ) all_cfs; let all_cfs = cfs @ all_cfs in @@ -1480,10 +1480,10 @@ struct let rec run md = if is_hxgen md then match md with - | TClassDecl ({ cl_interface = true } as cl) when cl.cl_path <> baseclass.cl_path && cl.cl_path <> baseinterface.cl_path && cl.cl_path <> basedynamic.cl_path -> + | TClassDecl cl when (has_class_flag cl CInterface) && cl.cl_path <> baseclass.cl_path && cl.cl_path <> baseinterface.cl_path && cl.cl_path <> basedynamic.cl_path -> cl.cl_implements <- (baseinterface, []) :: cl.cl_implements - | TClassDecl ({ cl_kind = KAbstractImpl _ }) -> - (* don't add any base classes to abstract implementations *) + | TClassDecl ({ cl_kind = KAbstractImpl _ | KModuleFields _ }) -> + (* don't add any base classes to abstract implementations and module field containers *) () | TClassDecl ({ cl_super = None } as cl) when cl.cl_path <> baseclass.cl_path && cl.cl_path <> baseinterface.cl_path && cl.cl_path <> basedynamic.cl_path -> cl.cl_super <- Some (baseclass,[]) @@ -1502,15 +1502,10 @@ end;; *) let priority = solve_deps name [DAfter UniversalBaseClass.priority] -let add_override cl cf = - if List.memq cf cl.cl_overrides then - cl.cl_overrides - else - cf :: cl.cl_overrides - let has_field_override cl name = try - cl.cl_overrides <- add_override cl (PMap.find name cl.cl_fields); + let cf = PMap.find name cl.cl_fields in + add_class_field_flag cf CfOverride; true with | Not_found -> false @@ -1518,7 +1513,7 @@ let has_field_override cl name = let configure ctx baseinterface ~slow_invoke = let run md = (match md with - | TClassDecl ({ cl_extern = false } as cl) when is_hxgen md && ( not cl.cl_interface || cl.cl_path = baseinterface.cl_path ) && (match cl.cl_kind with KAbstractImpl _ -> false | _ -> true) -> + | TClassDecl cl when not (has_class_flag cl CExtern) && is_hxgen md && ( not (has_class_flag cl CInterface) || cl.cl_path = baseinterface.cl_path ) && (match cl.cl_kind with KAbstractImpl _ | KModuleFields _ -> false | _ -> true) -> if is_some cl.cl_super then begin ignore (has_field_override cl (mk_internal_name "hx" "setField")); ignore (has_field_override cl (mk_internal_name "hx" "setField_f")); diff --git a/src/codegen/gencommon/setHXGen.ml b/src/codegen/gencommon/setHXGen.ml index dd9be5f5..db1e438e 100644 --- a/src/codegen/gencommon/setHXGen.ml +++ b/src/codegen/gencommon/setHXGen.ml @@ -39,7 +39,7 @@ let run_filter com types = is_hxgen (TAbstractDecl a) | TClassDecl cl -> let rec is_hxgen_class (c,_) = - if c.cl_extern then begin + if (has_class_flag c CExtern) then begin if Meta.has Meta.HxGen c.cl_meta then true else diff --git a/src/codegen/genxml.ml b/src/codegen/genxml.ml index 839977ee..95824dcc 100644 --- a/src/codegen/genxml.ml +++ b/src/codegen/genxml.ml @@ -132,7 +132,7 @@ and gen_type_decl n t pl = and gen_field att f = let add_get_set acc name att = match acc with - | AccNormal | AccResolve | AccRequire _ | AccCtor -> att + | AccNormal | AccRequire _ | AccCtor -> att | AccNo | AccNever -> (name, "null") :: att | AccCall -> (name,"accessor") :: att | AccInline -> (name,"inline") :: att @@ -173,6 +173,7 @@ and gen_field att f = in let att = if has_class_field_flag f CfPublic then ("public","1") :: att else att in let att = if has_class_field_flag f CfFinal then ("final","1") :: att else att in + let att = if has_class_field_flag f CfAbstract then ("abstract","1") :: att else att in node (field_name f) att (gen_type ~values:(Some values) f.cf_type :: gen_meta f.cf_meta @ gen_doc_opt f.cf_doc @ overloads) let gen_constr e = @@ -219,7 +220,7 @@ let rec gen_type_decl com pos t = ) c.cl_ordered_statics in let stats = List.map (gen_field ["static","1"]) stats in let fields = List.filter (fun cf -> - not (Meta.has Meta.GenericInstance cf.cf_meta) + not (Meta.has Meta.GenericInstance cf.cf_meta) && not (Meta.has Meta.NoDoc cf.cf_meta) ) c.cl_ordered_fields in let fields = (match c.cl_super with | None -> List.map (fun f -> f,[]) fields @@ -227,17 +228,18 @@ let rec gen_type_decl com pos t = ) in let fields = List.map (fun (f,att) -> gen_field att f) fields in let constr = (match c.cl_constructor with None -> [] | Some f -> [gen_field [] f]) in - let impl = List.map (gen_class_path (if c.cl_interface then "extends" else "implements")) c.cl_implements in + let impl = List.map (gen_class_path (if (has_class_flag c CInterface) then "extends" else "implements")) c.cl_implements in let tree = (match c.cl_super with | None -> impl | Some x -> gen_class_path "extends" x :: impl ) in let doc = gen_doc_opt c.cl_doc in let meta = gen_meta c.cl_meta in - let ext = (if c.cl_extern then [("extern","1")] else []) in - let interf = (if c.cl_interface then [("interface","1")] else []) in - let final = (if c.cl_final then [("final","1")] else []) in - node "class" (gen_type_params pos c.cl_private (tpath t) c.cl_params c.cl_pos m @ ext @ interf @ final) (tree @ stats @ fields @ constr @ doc @ meta) + let ext = (if (has_class_flag c CExtern) then [("extern","1")] else []) in + let interf = (if (has_class_flag c CInterface) then [("interface","1")] else []) in + let final = (if has_class_flag c CFinal then [("final","1")] else []) in + let abstract = (if has_class_flag c CAbstract then [("abstract","1")] else []) in + node "class" (gen_type_params pos c.cl_private (tpath t) c.cl_params c.cl_pos m @ ext @ interf @ final @ abstract) (tree @ stats @ fields @ constr @ doc @ meta) | TEnumDecl e -> let doc = gen_doc_opt e.e_doc in let meta = gen_meta e.e_meta in diff --git a/src/codegen/java.ml b/src/codegen/java.ml index dd700bfd..cc3736c2 100644 --- a/src/codegen/java.ml +++ b/src/codegen/java.ml @@ -176,15 +176,6 @@ let convert_constant ctx p const = | ConstFloat f | ConstDouble f -> Some (EConst (Float (Printf.sprintf "%E" f)), p) | _ -> None) None const -let rec same_sig parent jsig = - match jsig with - | TObject (p,targs) -> parent = p || List.exists (function | TType (_,s) -> same_sig parent s | _ -> false) targs - | TObjectInner(p, ntargs) -> - parent = (p, String.concat "$" (List.map fst ntargs)) || - List.exists (fun (_,targs) -> List.exists (function | TType(_,s) -> same_sig parent s | _ -> false) targs) ntargs - | TArray(s,_) -> same_sig parent s - | _ -> false - let convert_constraints ctx p tl = match tl with | [] -> None | [t] -> Some (convert_signature ctx p t,null_pos) @@ -197,7 +188,6 @@ let convert_param ctx p parent param = | (name, None, implemem_sig) -> name, implemem_sig in - let constraints = List.map (fun s -> if same_sig parent s then (TObject( (["java";"lang"], "Object"), [])) else s) constraints in { tp_name = jname_to_hx name,null_pos; tp_params = []; @@ -247,7 +237,7 @@ let convert_java_enum ctx p pe = d_data = List.rev !data; } - let convert_java_field ctx p jc field = + let convert_java_field ctx p jc is_interface field = let p = { p with pfile = p.pfile ^" (" ^field.jf_name ^")" } in let cff_doc = None in let cff_pos = p in @@ -285,6 +275,8 @@ let convert_java_enum ctx p pe = | JVolatile -> cff_meta := (Meta.Volatile, [], p) :: !cff_meta | JTransient -> cff_meta := (Meta.Transient, [], p) :: !cff_meta (* | JVarArgs -> cff_meta := (Meta.VarArgs, [], p) :: !cff_meta *) + | JAbstract when not is_interface -> + cff_access := (AAbstract, p) :: !cff_access | _ -> () ) field.jf_flags; @@ -307,6 +299,34 @@ let convert_java_enum ctx p pe = | _ -> () ) field.jf_throws; + let extract_local_names () = + let default i = + "param" ^ string_of_int i + in + match field.jf_code with + | None -> + default + | Some attribs -> try + let rec loop attribs = match attribs with + | AttrLocalVariableTable locals :: _ -> + locals + | _ :: attribs -> + loop attribs + | [] -> + raise Not_found + in + let locals = loop attribs in + let h = Hashtbl.create 0 in + List.iter (fun local -> + Hashtbl.replace h local.ld_index local.ld_name + ) locals; + (fun i -> + try Hashtbl.find h (i - 1) (* they are 1-based *) + with Not_found -> "param" ^ string_of_int i + ) + with Not_found -> + default + in let kind = match field.jf_kind with | JKField when !readonly -> FProp (("default",null_pos), ("null",null_pos), Some (convert_signature ctx p field.jf_signature,null_pos), None) @@ -315,6 +335,7 @@ let convert_java_enum ctx p pe = | JKMethod -> match field.jf_signature with | TMethod (args, ret) -> + let local_names = extract_local_names() in let old_types = ctx.jtparams in (match ctx.jtparams with | c :: others -> ctx.jtparams <- (c @ field.jf_types) :: others @@ -322,10 +343,10 @@ let convert_java_enum ctx p pe = let i = ref 0 in let args = List.map (fun s -> incr i; - ("param" ^ string_of_int !i,null_pos), false, [], Some(convert_signature ctx p s,null_pos), None + (local_names !i,null_pos), false, [], Some(convert_signature ctx p s,null_pos), None ) args in let t = Option.map_default (convert_signature ctx p) (mk_type_path ctx ([], "Void") []) ret in - cff_meta := (Meta.Overload, [], p) :: !cff_meta; + cff_access := (AOverload,p) :: !cff_access; let types = List.map (function | (name, Some ext, impl) -> { @@ -423,16 +444,20 @@ let convert_java_enum ctx p pe = meta := (Meta.LibType,[],p) :: !meta; let is_interface = ref false in + let is_abstract = ref false in List.iter (fun f -> match f with | JFinal -> flags := HFinal :: !flags | JInterface -> is_interface := true; flags := HInterface :: !flags - | JAbstract -> meta := (Meta.Abstract, [], p) :: !meta + | JAbstract -> + meta := (Meta.Abstract, [], p) :: !meta; + is_abstract := true; | JAnnotation -> meta := (Meta.Annotation, [], p) :: !meta | _ -> () ) jc.cflags; + if !is_abstract && not !is_interface then flags := HAbstract :: !flags; (match jc.csuper with | TObject( (["java";"lang"], "Object"), _ ) -> () | TObject( (["haxe";"lang"], "HxObject"), _ ) -> meta := (Meta.HxGen,[],p) :: !meta @@ -458,7 +483,7 @@ let convert_java_enum ctx p pe = if !is_interface && List.mem JStatic f.jf_flags then () else begin - fields := convert_java_field ctx p jc f :: !fields; + fields := convert_java_field ctx p jc !is_interface f :: !fields; jfields := f :: !jfields end with @@ -660,7 +685,7 @@ let compare_type com s1 s2 = let implements = List.map (japply_params jparams) c.cinterfaces in loop ~first_error:first_error super s2 || List.exists (fun super -> loop ~first_error:first_error super s2) implements with | Not_found -> - print_endline ("-java-lib: The type " ^ (s_sig s1) ^ " is referred but was not found. Compilation may not occur correctly."); + print_endline ("--java-lib: The type " ^ (s_sig s1) ^ " is referred but was not found. Compilation may not occur correctly."); print_endline "Did you forget to include a needed lib?"; if first_error then not (loop ~first_error:false s2 s1) @@ -1071,20 +1096,24 @@ class java_library_jar com name file_path = object(self) val zip = lazy (Zip.open_in file_path) val mutable cached_files = None val cached_types = Hashtbl.create 12 + val mutable loaded = false val mutable closed = false method load = - List.iter (function - | { Zip.is_directory = false; Zip.filename = filename } when String.ends_with filename ".class" -> - let pack = String.nsplit filename "/" in - (match List.rev pack with - | [] -> () - | name :: pack -> - let name = String.sub name 0 (String.length name - 6) in - let pack = List.rev pack in - Hashtbl.add hxpack_to_jpack (jpath_to_hx (pack,name)) (pack,name)) - | _ -> () - ) (Zip.entries (Lazy.force zip)) + if not loaded then begin + loaded <- true; + List.iter (function + | { Zip.is_directory = false; Zip.filename = filename } when String.ends_with filename ".class" -> + let pack = String.nsplit filename "/" in + (match List.rev pack with + | [] -> () + | name :: pack -> + let name = String.sub name 0 (String.length name - 6) in + let pack = List.rev pack in + Hashtbl.add hxpack_to_jpack (jpath_to_hx (pack,name)) (pack,name)) + | _ -> () + ) (Zip.entries (Lazy.force zip)) + end method private lookup' ((pack,name) : path) : java_lib_type = try @@ -1101,17 +1130,18 @@ class java_library_jar com name file_path = object(self) try Hashtbl.find cached_types path with | Not_found -> try + self#load; let pack, name = self#convert_path path in let try_file (pack,name) = match self#lookup' (pack,name) with | None -> - Hashtbl.add cached_types path None; - None + Hashtbl.add cached_types path None; + None | Some (i, p1, p2) -> - Hashtbl.add cached_types path (Some(i,p1,p2)); (* type loop normalization *) - let ret = Some (normalize_jclass com i, p1, p2) in - Hashtbl.replace cached_types path ret; - ret + Hashtbl.add cached_types path (Some(i,p1,p2)); (* type loop normalization *) + let ret = Some (normalize_jclass com i, p1, p2) in + Hashtbl.replace cached_types path ret; + ret in try_file (pack,name) with Not_found -> @@ -1188,7 +1218,7 @@ class java_library_dir com name file_path = object(self) | _ -> None end -let add_java_lib com name std extern = +let add_java_lib com name std extern modern = let file = if Sys.file_exists name then name else try Common.find_file com name with @@ -1196,11 +1226,14 @@ let add_java_lib com name std extern = | Not_found -> failwith ("Java lib " ^ name ^ " not found") in - let java_lib = match (Unix.stat file).st_kind with + let java_lib = + if modern then + (new JavaModern.java_library_modern com name file :> (java_lib_type,unit) native_library) + else match (Unix.stat file).st_kind with | S_DIR -> - (new java_library_dir com name file :> java_library) + (new java_library_dir com name file :> (java_lib_type,unit) native_library) | _ -> - (new java_library_jar com name file :> java_library) + (new java_library_jar com name file :> (java_lib_type,unit) native_library) in if std then java_lib#add_flag FlagIsStd; if extern then java_lib#add_flag FlagIsExtern; diff --git a/src/codegen/javaModern.ml b/src/codegen/javaModern.ml new file mode 100644 index 00000000..72bcdb69 --- /dev/null +++ b/src/codegen/javaModern.ml @@ -0,0 +1,1032 @@ +open Globals +open Ast +open ExtString +open NativeLibraries + +module AccessFlags = struct + type t = + | MPublic + | MPrivate + | MProtected + | MStatic + | MFinal + | MSynchronized + | MBridge + | MVarargs + | MNative + | MInterface + | MAbstract + | MStrict + | MSynthetic + | MEnum + + let to_int = function + | MPublic -> 0x1 + | MPrivate -> 0x2 + | MProtected -> 0x4 + | MStatic -> 0x8 + | MFinal -> 0x10 + | MSynchronized -> 0x20 + | MBridge -> 0x40 + | MVarargs -> 0x80 + | MNative -> 0x100 + | MInterface -> 0x200 + | MAbstract -> 0x400 + | MStrict -> 0x800 + | MSynthetic -> 0x1000 + | MEnum -> 0x4000 + + let has_flag b flag = + b land (to_int flag) <> 0 +end + +module JDataHoldovers = struct + type jwildcard = + | WExtends (* + *) + | WSuper (* - *) + | WNone + + type jtype_argument = + | TType of jwildcard * jsignature + | TAny (* * *) + + and jsignature = + | TByte (* B *) + | TChar (* C *) + | TDouble (* D *) + | TFloat (* F *) + | TInt (* I *) + | TLong (* J *) + | TShort (* S *) + | TBool (* Z *) + | TObject of path * jtype_argument list (* L Classname *) + | TObjectInner of (string list) * (string * jtype_argument list) list (* L Classname ClassTypeSignatureSuffix *) + | TArray of jsignature * int option (* [ *) + | TMethod of jmethod_signature (* ( *) + | TTypeParameter of string (* T *) + + (* ( jsignature list ) ReturnDescriptor (| V | jsignature) *) + and jmethod_signature = jsignature list * jsignature option + + type jtypes = (string * jsignature option * jsignature list) list + + type jannotation = { + ann_type : jsignature; + ann_elements : (string * jannotation_value) list; + } + + and jannotation_value = + | ValConst of jsignature * int + | ValEnum of jsignature * string (* e *) + | ValClass of jsignature (* c *) (* V -> Void *) + | ValAnnotation of jannotation (* @ *) + | ValArray of jannotation_value list (* [ *) +end + +open JDataHoldovers + +module JReaderHoldovers = struct + open JDataHoldovers + + let rec parse_type_parameter_part s = match s.[0] with + | '*' -> TAny, 1 + | c -> + let wildcard, i = match c with + | '+' -> WExtends, 1 + | '-' -> WSuper, 1 + | _ -> WNone, 0 + in + let jsig, l = parse_signature_part (String.sub s i (String.length s - 1)) in + (TType (wildcard, jsig), l + i) + + and parse_signature_part s = + let len = String.length s in + if len = 0 then raise Exit; + match s.[0] with + | 'B' -> TByte, 1 + | 'C' -> TChar, 1 + | 'D' -> TDouble, 1 + | 'F' -> TFloat, 1 + | 'I' -> TInt, 1 + | 'J' -> TLong, 1 + | 'S' -> TShort, 1 + | 'Z' -> TBool, 1 + | 'L' -> + (try + let orig_s = s in + let rec loop start i acc = + match s.[i] with + | '/' -> loop (i + 1) (i + 1) (String.sub s start (i - start) :: acc) + | ';' | '.' -> List.rev acc, (String.sub s start (i - start)), [], (i) + | '<' -> + let name = String.sub s start (i - start) in + let rec loop_params i acc = + let s = String.sub s i (len - i) in + match s.[0] with + | '>' -> List.rev acc, i + 1 + | _ -> + let tp, l = parse_type_parameter_part s in + loop_params (l + i) (tp :: acc) + in + let params, _end = loop_params (i + 1) [] in + List.rev acc, name, params, (_end) + | _ -> loop start (i+1) acc + in + let pack, name, params, _end = loop 1 1 [] in + let rec loop_inner i acc = + match s.[i] with + | '.' -> + let pack, name, params, _end = loop (i+1) (i+1) [] in + if pack <> [] then failwith ("Inner types must not define packages. For '" ^ orig_s ^ "'."); + loop_inner _end ( (name,params) :: acc ) + | ';' -> List.rev acc, i + 1 + | c -> failwith ("End of complex type signature expected after type parameter. Got '" ^ Char.escaped c ^ "' for '" ^ orig_s ^ "'." ); + in + let inners, _end = loop_inner _end [] in + match inners with + | [] -> TObject((pack,name), params), _end + | _ -> TObjectInner( pack, (name,params) :: inners ), _end + with + Invalid_string -> raise Exit) + | '[' -> + let p = ref 1 in + while !p < String.length s && s.[!p] >= '0' && s.[!p] <= '9' do + incr p; + done; + let size = (if !p > 1 then Some (int_of_string (String.sub s 1 (!p - 1))) else None) in + let s , l = parse_signature_part (String.sub s !p (String.length s - !p)) in + TArray (s,size) , l + !p + | '(' -> + let p = ref 1 in + let args = ref [] in + while !p < String.length s && s.[!p] <> ')' do + let a , l = parse_signature_part (String.sub s !p (String.length s - !p)) in + args := a :: !args; + p := !p + l; + done; + incr p; + if !p >= String.length s then raise Exit; + let ret , l = (match s.[!p] with 'V' -> None , 1 | _ -> + let s, l = parse_signature_part (String.sub s !p (String.length s - !p)) in + Some s, l + ) in + TMethod (List.rev !args,ret) , !p + l + | 'T' -> + (try + let s1 , _ = String.split s ";" in + let len = String.length s1 in + TTypeParameter (String.sub s1 1 (len - 1)) , len + 1 + with + Invalid_string -> raise Exit) + | _ -> + raise Exit + + let parse_signature s = + try + let sign , l = parse_signature_part s in + if String.length s <> l then raise Exit; + sign + with + Exit -> failwith ("Invalid signature '" ^ s ^ "'") + + let parse_method_signature s = + match parse_signature s with + | (TMethod m) -> m + | _ -> failwith ("Unexpected signature '" ^ s ^ "'. Expecting method") + + let parse_formal_type_params s = match s.[0] with + | '<' -> + let rec read_id i = + match s.[i] with + | ':' | '>' -> i + | _ -> read_id (i + 1) + in + let len = String.length s in + let rec parse_params idx acc = + let idi = read_id (idx + 1) in + let id = String.sub s (idx + 1) (idi - idx - 1) in + (* next must be a : *) + (match s.[idi] with | ':' -> () | _ -> failwith ("Invalid formal type signature character: " ^ Char.escaped s.[idi] ^ " ; from " ^ s)); + let ext, l = match s.[idi + 1] with + | ':' | '>' -> None, idi + 1 + | _ -> + let sgn, l = parse_signature_part (String.sub s (idi + 1) (len - idi - 1)) in + Some sgn, l + idi + 1 + in + let rec loop idx acc = + match s.[idx] with + | ':' -> + let ifacesig, ifacei = parse_signature_part (String.sub s (idx + 1) (len - idx - 1)) in + loop (idx + ifacei + 1) (ifacesig :: acc) + | _ -> acc, idx + in + let ifaces, idx = loop l [] in + let acc = (id, ext, ifaces) :: acc in + if s.[idx] = '>' then List.rev acc, idx + 1 else parse_params (idx - 1) acc + in + parse_params 0 [] + | _ -> [], 0 + + let parse_throws s = + let len = String.length s in + let rec loop idx acc = + if idx > len then raise Exit + else if idx = len then acc, idx + else match s.[idx] with + | '^' -> + let tsig, l = parse_signature_part (String.sub s (idx+1) (len - idx - 1)) in + loop (idx + l + 1) (tsig :: acc) + | _ -> acc, idx + in + loop 0 [] + + let parse_complete_method_signature s = + try + let len = String.length s in + let tparams, i = parse_formal_type_params s in + let sign, l = parse_signature_part (String.sub s i (len - i)) in + let throws, l2 = parse_throws (String.sub s (i+l) (len - i - l)) in + if (i + l + l2) <> len then raise Exit; + + match sign with + | TMethod msig -> tparams, msig, throws + | _ -> raise Exit + with + Exit -> failwith ("Invalid method extended signature '" ^ s ^ "'") +end + +module JReaderModern = struct + open IO + open IO.BigEndian + + open JReaderHoldovers + + type constant_pool = { + strings : string array; + paths : path array; + name_and_types : (string * string) array; + } + + type jlocal = { + ld_start_pc : int; + ld_length : int; + ld_name : string; + ld_descriptor : string; + ld_index : int; + } + + type jattribute = + | AttrCode of jattribute list + | AttrDeprecated + | AttrLocalVariableTable of jlocal list + | AttrMethodParameters of (string * int) list + | AttrSignature of string + | AttrVisibleAnnotations of jannotation list + | AttrOther + + type jfield = { + jf_name : string; + jf_flags : int; + jf_types : jtypes; + jf_descriptor : jsignature; + jf_attributes : jattribute list; + jf_code : jattribute list option; + } + + type jclass = { + jc_path : path; + jc_flags : int; + jc_super : jsignature; + jc_interfaces : jsignature list; + jc_types : jtypes; + jc_fields : jfield list; + jc_methods : jfield list; + jc_attributes : jattribute list; + } + + let read_constant_pool ch = + let count = read_ui16 ch in + let strings = Array.make count "" in + let paths = Array.make count 0 in + let name_and_types = Array.make count (0,0) in + let i = ref 1 in + while !i < count do + begin match read_byte ch with + | 1 -> + strings.(!i) <- nread_string ch (read_ui16 ch) + | 3 -> + ignore(read_real_i32 ch) + | 4 -> + ignore(read_float32 ch) + | 5 -> + incr i; + ignore(read_i64 ch) + | 6 -> + incr i; + ignore(read_double ch) + | 7 -> + paths.(!i) <- read_ui16 ch + | 8 -> + ignore(read_ui16 ch) + | 9 | 10 | 11 -> + ignore(read_ui16 ch); + ignore(read_ui16 ch); + | 12 -> + let name = read_ui16 ch in + let t = read_ui16 ch in + name_and_types.(!i) <- (name,t); + | 15 -> + ignore(read_byte ch); + ignore(read_ui16 ch); + | 16 -> + ignore(read_ui16 ch); + | 17 | 18 -> + ignore(read_ui16 ch); + ignore(read_ui16 ch); + | 19 | 20 -> + ignore(read_ui16 ch); + | i -> + failwith (Printf.sprintf "Invalid constant pool byte: %i" i); + end; + incr i; + done; + let as_path s = match List.rev (String.nsplit s "/") with + | [x] -> [],x + | x :: l -> List.rev l,x + | [] -> assert false + in + let paths = Array.map (fun index -> + if index > 0 then as_path (strings.(index)) + else ([],"") + ) paths in + let name_and_types = Array.map (fun (name,t) -> + let name = if name > 0 then strings.(name) else "" in + let t = if t > 0 then strings.(t) else "" in + (name,t) + ) name_and_types in + {strings;paths;name_and_types} + + + let rec parse_element_value consts ch = + let tag = IO.read_byte ch in + match Char.chr tag with + | 'B' | 'C' | 'D' | 'F' | 'I' | 'J' | 'S' | 'Z' | 's' -> + let jsig = match (Char.chr tag) with + | 's' -> + TObject( (["java";"lang"],"String"), [] ) + | tag -> + fst (parse_signature_part (Char.escaped tag)) + in + ValConst(jsig,(read_ui16 ch)) + | 'e' -> + let path = parse_signature (consts.strings.(read_ui16 ch)) in + let name = consts.strings.(read_ui16 ch) in + ValEnum (path, name) + | 'c' -> + let name = consts.strings.(read_ui16 ch) in + let jsig = if name = "V" then + TObject(([], "Void"), []) + else + parse_signature name + in + ValClass jsig + | '@' -> + ValAnnotation (parse_annotation consts ch) + | '[' -> + let num_vals = read_ui16 ch in + ValArray (ExtList.List.init (num_vals) (fun _ -> parse_element_value consts ch)) + | tag -> + failwith ("Invalid element value: '" ^ Char.escaped tag ^ "'") + + and parse_ann_element consts ch = + let name = consts.strings.(read_ui16 ch) in + let element_value = parse_element_value consts ch in + name, element_value + + and parse_annotation consts ch = + let anntype = parse_signature (consts.strings.(read_ui16 ch)) in + let count = read_ui16 ch in + { + ann_type = anntype; + ann_elements = ExtList.List.init count (fun _ -> parse_ann_element consts ch) + } + + let rec parse_attribute consts ch = + let name = consts.strings.(read_ui16 ch) in + let length = read_i32 ch in + match name with + | "Code" -> + ignore(read_ui16 ch); (* max stack *) + ignore(read_ui16 ch); (* max locals *) + let len = read_i32 ch in + ignore(IO.nread_string ch len); (* code *) + let len = read_ui16 ch in + for i = 0 to len - 1 do + ignore(IO.nread_string ch 8); + done; (* exceptions *) + let attribs = parse_attributes consts ch in + AttrCode attribs + | "Deprecated" -> + AttrDeprecated + | "LocalVariableTable" -> + let len = read_ui16 ch in + let locals = ExtList.List.init len (fun _ -> + let start_pc = read_ui16 ch in + let length = read_ui16 ch in + let name = consts.strings.(read_ui16 ch) in + let descriptor = consts.strings.(read_ui16 ch) in + let index = read_ui16 ch in + { + ld_start_pc = start_pc; + ld_length = length; + ld_name = name; + ld_descriptor = descriptor; + ld_index = index + } + ) in + AttrLocalVariableTable locals + | "MethodParameters" -> + let len = IO.read_byte ch in + let parameters = ExtList.List.init len (fun _ -> + let name = consts.strings.(read_ui16 ch) in + let flags = read_ui16 ch in + (name,flags) + ) in + AttrMethodParameters parameters + | "RuntimeVisibleAnnotations" -> + let count = read_ui16 ch in + AttrVisibleAnnotations (ExtList.List.init count (fun _ -> parse_annotation consts ch)) + | "Signature" -> + let s = consts.strings.(read_ui16 ch) in + AttrSignature s + | _ -> + ignore(nread ch length); + AttrOther + + and parse_attributes consts ch = + Array.to_list (Array.init (read_ui16 ch) (fun _ -> + parse_attribute consts ch + )) + + let parse_field consts is_method ch = + let flags = read_ui16 ch in + let name = consts.strings.(read_ui16 ch) in + let descriptor = consts.strings.(read_ui16 ch) in + let attributes = parse_attributes consts ch in + let types = ref [] in + let jsig = ref None in + let code = ref None in + List.iter (function + | AttrCode code' -> + code := Some code' + | AttrSignature s -> + if is_method then begin + let tp, sgn, thr = parse_complete_method_signature s in + types := tp; + jsig := Some (TMethod(sgn)); + end else + jsig := Some (parse_signature s) + | _ -> + () + ) attributes; + { + jf_name = name; + jf_flags = flags; + jf_types = !types; + jf_descriptor = (match !jsig with + | None -> parse_signature descriptor; + | Some jsig -> jsig); + jf_attributes = attributes; + jf_code = !code; + } + + let parse_class ch = + if read_real_i32 ch <> 0xCAFEBABEl then failwith "Invalid header"; + let _ = read_ui16 ch in + let _ = read_ui16 ch in + let consts = read_constant_pool ch in + let flags = read_ui16 ch in + let this = consts.paths.(read_ui16 ch) in + let super = TObject(consts.paths.(read_ui16 ch),[]) in + let interfaces = ExtList.List.init (read_ui16 ch) (fun _ -> + TObject(consts.paths.(read_ui16 ch),[]) + ) in + let fields = ExtList.List.init (read_ui16 ch) (fun _ -> parse_field consts false ch) in + let methods = ExtList.List.init (read_ui16 ch) (fun _ -> parse_field consts true ch) in + let attributes = parse_attributes consts ch in + let types = ref [] in + let interfaces = ref interfaces in + let super = ref super in + List.iter (function + | AttrSignature s -> + let formal, idx = parse_formal_type_params s in + types := formal; + let s = String.sub s idx (String.length s - idx) in + let len = String.length s in + let sup, idx = parse_signature_part s in + let rec loop idx acc = + if idx = len then + acc + else begin + let s = String.sub s idx (len - idx) in + let iface, i2 = parse_signature_part s in + loop (idx + i2) (iface :: acc) + end + in + interfaces := loop idx []; + super := sup; + | _ -> + () + ) attributes; + { + jc_path = this; + jc_flags = flags; + jc_super = !super; + jc_interfaces = !interfaces; + jc_types = !types; + jc_fields = fields; + jc_methods = methods; + jc_attributes = attributes; + } +end + +module PathConverter = struct + let jname_to_hx name = + let name = + if name <> "" && (String.get name 0 < 'A' || String.get name 0 > 'Z') then + Char.escaped (Char.uppercase (String.get name 0)) ^ String.sub name 1 (String.length name - 1) + else + name + in + let name = String.concat "__" (String.nsplit name "_") in + match String.nsplit name "$" with + | [] -> + die "" __LOC__ + | [_] -> + None,name + | [x;""] -> + None,x ^ "_" (* trailing $ *) + | x :: l -> + let name = String.concat "_" (x :: l) in + if x = "" then None,name (* leading $ *) + else Some x,name + + let normalize_pack pack = + List.map (function + | "" -> "" + | str when String.get str 0 >= 'A' && String.get str 0 <= 'Z' -> + String.lowercase str + | str -> str + ) pack + + let jpath_to_hx (pack,name) = + let pack,name = match pack,name with + | ["haxe";"root"],name -> + [],name + | "com" :: ("oracle" | "sun") :: _, _ + | "javax" :: _, _ + | "org" :: ("ietf" | "jcp" | "omg" | "w3c" | "xml") :: _, _ + | "sun" :: _, _ + | "sunw" :: _, _ -> + "java" :: pack,name + | _ -> + pack,name + in + let pack = normalize_pack pack in + pack,jname_to_hx name + + let jpath_to_path (pack,(mname,name)) = + let pack,name = match mname with + | None -> pack,name + | Some mname -> pack @ [mname],name + in + pack,name + + let is_haxe_keyword = function + | "cast" | "extern" | "function" | "in" | "typedef" | "using" | "var" | "untyped" | "inline" -> true + | _ -> false +end + +type java_lib_ctx = { + type_params : (string,complex_type) PMap.t; +} + +module SignatureConverter = struct + open PathConverter + + let mk_type_path path params = + let pack,(mname,name) = jpath_to_hx path in + match mname with + | None -> + CTPath { + tpackage = pack; + tname = name; + tparams = params; + tsub = None; + } + | Some mname -> + CTPath { + tpackage = pack; + tname = mname; + tparams = params; + tsub = Some name; + } + + let ct_type_param name = CTPath { + tpackage = []; + tname = name; + tparams = []; + tsub = None + } + + let ct_void = CTPath { + tpackage = []; + tname = "Void"; + tparams = []; + tsub = None; + } + + let ct_dynamic = CTPath { + tpackage = []; + tname = "Dynamic"; + tparams = []; + tsub = None; + } + + let ct_string = CTPath { + tpackage = []; + tname = "String"; + tparams = []; + tsub = None; + } + + let rec convert_arg ctx p arg = + match arg with + | TAny | TType (WSuper, _) -> TPType (mk_type_path ([], "Dynamic") [],p) + | TType (_, jsig) -> TPType (convert_signature ctx p jsig,p) + + and convert_signature ctx p jsig = + match jsig with + | TByte -> mk_type_path (["java"; "types"], "Int8") [] + | TChar -> mk_type_path (["java"; "types"], "Char16") [] + | TDouble -> mk_type_path ([], "Float") [] + | TFloat -> mk_type_path ([], "Single") [] + | TInt -> mk_type_path ([], "Int") [] + | TLong -> mk_type_path (["haxe"], "Int64") [] + | TShort -> mk_type_path (["java"; "types"], "Int16") [] + | TBool -> mk_type_path ([], "Bool") [] + | TObject ( (["haxe";"root"], name), args ) -> mk_type_path ([], name) (List.map (convert_arg ctx p) args) + | TObject ( (["java";"lang"], "Object"), [] ) -> mk_type_path ([], "Dynamic") [] + | TObject ( (["java";"lang"], "String"), [] ) -> mk_type_path ([], "String") [] + | TObject ( (["java";"lang"], "Enum"), [_] ) -> mk_type_path ([], "EnumValue") [] + | TObject ( path, [] ) -> + mk_type_path path [] + | TObject ( path, args ) -> mk_type_path path (List.map (convert_arg ctx p) args) + | TObjectInner (pack, (name, params) :: inners) -> + let actual_param = match List.rev inners with + | (_, p) :: _ -> p + | _ -> die "" __LOC__ in + mk_type_path (pack, name ^ "$" ^ String.concat "$" (List.map fst inners)) (List.map (fun param -> convert_arg ctx p param) actual_param) + | TObjectInner (pack, inners) -> die "" __LOC__ + | TArray (jsig, _) -> mk_type_path (["java"], "NativeArray") [ TPType (convert_signature ctx p jsig,p) ] + | TMethod _ -> failwith "TMethod cannot be converted directly into Complex Type" + | TTypeParameter s -> + try + PMap.find s ctx.type_params + with Not_found -> + ct_dynamic +end + +let get_type_path ct = match ct with | CTPath p -> p | _ -> die "" __LOC__ + +module Converter = struct + + open JReaderModern + open PathConverter + open SignatureConverter + + let convert_type_parameter ctx (name,extends,implements) p = + let jsigs = match extends with + | Some jsig -> jsig :: implements + | None -> implements + in + let constraints = ExtList.List.filter_map (fun jsig -> match jsig with + | TTypeParameter name' when name = name' -> + None + | _ -> + Some (convert_signature ctx p jsig,p) + ) jsigs in + let tp = { + tp_name = (name,p); + tp_params = []; + tp_meta = []; + tp_constraints = match constraints with + | [] -> None + | _ -> Some (CTIntersection constraints,p) + } in + tp + + let convert_enum (jc : jclass) (file : string) = + let p = { + pfile = file; + pmin = 0; + pmax = 0 + } in + let meta = ref [] in + let add_meta m = meta := m :: !meta in + let data = ref [] in + List.iter (fun (jf : jfield) -> + match jf.jf_descriptor with + | TObject( path, [] ) when path = jc.jc_path && AccessFlags.has_flag jf.jf_flags MStatic && AccessFlags.has_flag jf.jf_flags MFinal -> + data := { ec_name = jf.jf_name,p; ec_doc = None; ec_meta = []; ec_args = []; ec_pos = p; ec_params = []; ec_type = None; } :: !data; + | _ -> () + ) jc.jc_fields; + let _,class_name = jname_to_hx (snd jc.jc_path) in + add_meta (Meta.Native, [EConst (String (s_type_path jc.jc_path,SDoubleQuotes) ),p],p); + let d = { + d_name = (class_name,p); + d_doc = None; + d_params = []; (* enums never have type parameters *) + d_meta = !meta; + d_flags = [EExtern]; + d_data = List.rev !data; + } in + (EEnum d,p) + + let type_param_lut acc params = + List.fold_left (fun acc (s,_,_) -> + PMap.add s (ct_type_param s) acc + ) acc params + + let convert_field ctx is_method (jc : jclass) (is_interface : bool) (jf : jfield) p = + let ctx = { + type_params = type_param_lut ctx.type_params jf.jf_types; + } in + let p = {p with pfile = p.pfile ^ "@" ^ jf.jf_name} in + let is_static = AccessFlags.has_flag jf.jf_flags MStatic in + let access = ref [] in + let meta = ref [] in + let add_access a = access := a :: !access in + let add_meta m = meta := m :: !meta in + if is_static then add_access (AStatic,p); + List.iter (function + | AttrDeprecated when jc.jc_path <> (["java";"util"],"Date") -> + add_meta (Meta.Deprecated,[],p); + | AttrVisibleAnnotations ann -> + List.iter (function + | { ann_type = TObject( (["java";"lang"], "Override"), [] ) } -> + add_access (AOverride,null_pos); + | _ -> () + ) ann + | _ -> () + ) jf.jf_attributes; + let add_native_meta () = + add_meta (Meta.Native, [EConst (String (jf.jf_name,SDoubleQuotes) ),p],p) + in + let name = match String.nsplit jf.jf_name "$" with + | [""] -> + "new" + | [name] -> + if is_haxe_keyword name then begin + add_native_meta(); + "_" ^ name + end else + name + | parts -> + add_native_meta(); + String.concat "_" parts + in + if is_method then add_access (AOverload,p); + if AccessFlags.has_flag jf.jf_flags MFinal then add_access (AFinal,p); + if not is_interface && AccessFlags.has_flag jf.jf_flags MAbstract then add_access (AAbstract,p); + let extract_local_names () = + let default i = + "param" ^ string_of_int i + in + let rec loop attribs = match attribs with + | AttrLocalVariableTable locals :: _ -> + let shift = if is_static then 0 else -1 in + List.map (fun loc -> + loc.ld_index + shift,loc.ld_name + ) locals + | AttrMethodParameters l :: _ -> + List.mapi (fun i (name,_) -> + (i,name) + ) l + | _ :: attribs -> + loop attribs + | [] -> + raise Not_found + in + let use locals = + let h = Hashtbl.create 0 in + List.iter (fun (index,name) -> + Hashtbl.replace h index name + ) locals; + (fun i -> + try Hashtbl.find h (i - 1) (* they are 1-based *) + with Not_found -> "param" ^ string_of_int i + ) + in + try + use (loop jf.jf_attributes) + with Not_found -> try + match jf.jf_code with + | None -> + default + | Some attribs -> + use (loop attribs) + with Not_found -> + default + in + let kind = if not is_method then + FVar(Some (convert_signature ctx p jf.jf_descriptor,p),None) + else + begin match jf.jf_descriptor with + | TMethod(args,ret) -> + let local_names = extract_local_names() in + let convert_arg i jsig = + let name = local_names (i + 1) in + ((name,p),false,[],Some (convert_signature ctx p jsig,p),None) + in + let f = { + f_params = List.map (fun tp -> convert_type_parameter ctx tp p) jf.jf_types; + f_args = List.mapi convert_arg args; + f_type = Some (Option.map_default (fun jsig -> convert_signature ctx p jsig,p) (ct_void,p) ret); + f_expr = None; + } in + FFun f + | _ -> + assert false + end + in + let cff = { + cff_name = (name,p); + cff_doc = None; + cff_pos = p; + cff_meta = !meta; + cff_access = !access; + cff_kind = kind; + } in + cff + + let convert_class ctx (jc : jclass) (file : string) = + let p = { + pfile = file; + pmin = 0; + pmax = 0 + } in + let flags = ref [HExtern] in + let meta = ref [] in + let add_flag f = flags := f :: !flags in + let add_meta m = meta := m :: !meta in + add_meta (Meta.LibType,[],p); + let is_interface = AccessFlags.has_flag jc.jc_flags MInterface in + if is_interface then add_flag HInterface + else if AccessFlags.has_flag jc.jc_flags MAbstract then add_flag HAbstract; + begin match jc.jc_super with + | TObject(([],""),_) + | TObject((["java";"lang"],"Object"),_) -> + () + | jsig -> + add_flag (HExtends (get_type_path (convert_signature ctx p jsig),p)) + end; + List.iter (fun jsig -> + let path = (get_type_path (convert_signature ctx p jsig),p) in + if is_interface then + add_flag (HExtends path) + else + add_flag (HImplements path) + ) jc.jc_interfaces; + let fields = DynArray.create () in + let known_names = Hashtbl.create 0 in + let known_sigs = Hashtbl.create 0 in + let should_generate jf = + not (AccessFlags.has_flag jf.jf_flags MPrivate) + in + if jc.jc_path <> (["java";"lang"], "CharSequence") then begin + List.iter (fun jf -> + if should_generate jf then begin + Hashtbl.replace known_names jf.jf_name jf; + let sig_key = match jf.jf_descriptor with + | TMethod(jsigs,_) -> TMethod(jsigs,None) (* lack of return type variance *) + | jsig -> jsig + in + let key = (jf.jf_name,sig_key) in + if not (Hashtbl.mem known_sigs key) then begin + Hashtbl.add known_sigs key jf; + DynArray.add fields (convert_field ctx true jc is_interface jf p) + end + end + ) jc.jc_methods; + List.iter (fun jf -> + if should_generate jf then begin + if not (Hashtbl.mem known_names jf.jf_name) then begin + Hashtbl.add known_names jf.jf_name jf; + DynArray.add fields (convert_field ctx false jc is_interface jf p) + end + end + ) jc.jc_fields; + end; + let _,class_name = jname_to_hx (snd jc.jc_path) in + add_meta (Meta.Native, [EConst (String (s_type_path jc.jc_path,SDoubleQuotes) ),p],p); + let d = { + d_name = (class_name,p); + d_doc = None; + d_params = List.map (fun tp -> convert_type_parameter ctx tp p) jc.jc_types; + d_meta = !meta; + d_flags = !flags; + d_data = DynArray.to_list fields; + } in + (EClass d,p) + + let convert_type ctx jc file = + if AccessFlags.has_flag jc.jc_flags MEnum then convert_enum jc file else convert_class ctx jc file + + let convert_module pack jcs = + let types = List.map (fun (jc,_,file) -> + let ctx = { + type_params = type_param_lut PMap.empty jc.jc_types; + } in + convert_type ctx jc file; + ) jcs in + (pack,types) +end + +class java_library_modern com name file_path = object(self) + inherit [java_lib_type,unit] native_library name file_path as super + + + val zip = lazy (Zip.open_in file_path) + val mutable cached_files = [] + val modules = Hashtbl.create 0 + val mutable loaded = false + val mutable closed = false + + method load = + if not loaded then begin + loaded <- true; + let close = Timer.timer ["jar";"load"] in + List.iter (function + | ({ Zip.is_directory = false; Zip.filename = filename } as entry) when String.ends_with filename ".class" -> + let pack = String.nsplit filename "/" in + begin match List.rev pack with + | [] -> () + | name :: pack -> + let name = String.sub name 0 (String.length name - 6) in + let pack = List.rev pack in + let pack,(mname,tname) = PathConverter.jpath_to_hx (pack,name) in + let path = PathConverter.jpath_to_path (pack,(mname,tname)) in + let mname = match mname with + | None -> + cached_files <- path :: cached_files; + tname + | Some mname -> mname + in + Hashtbl.add modules (pack,mname) (filename,entry); + end + | _ -> () + ) (Zip.entries (Lazy.force zip)); + close(); + end + + method private read zip (filename,entry) = + Std.finally (Timer.timer ["jar";"read"]) (fun () -> + let data = Zip.read_entry zip entry in + let jc = JReaderModern.parse_class (IO.input_string data) in + (jc,file_path,file_path ^ "@" ^ filename) + ) () + + method lookup path : java_lib_type = + None + + method close = + if not closed then begin + closed <- true; + Zip.close_in (Lazy.force zip) + end + + method list_modules : path list = + cached_files + + method build path (p : pos) : Ast.package option = + let build path = + if path = (["java";"lang"],"String") then + None + else begin + try + let entries = Hashtbl.find_all modules path in + if entries = [] then raise Not_found; + let zip = Lazy.force zip in + let jcs = List.map (self#read zip) entries in + Std.finally (Timer.timer ["jar";"convert"]) (fun () -> + Some (Converter.convert_module (fst path) jcs) + ) (); + with Not_found -> + None + end + in + build path + + method get_data = () +end \ No newline at end of file diff --git a/src/codegen/overloads.ml b/src/codegen/overloads.ml index c7f48e60..5817c4d4 100644 --- a/src/codegen/overloads.ml +++ b/src/codegen/overloads.ml @@ -2,98 +2,93 @@ open Globals open Type open Typecore -type overload_args_comparison = - | Same - | Different - | Impl_conflict - -let distinguishes_funs_as_params ctx = - match ctx.com.platform with - | Java -> false - | _ -> true - -let compare_overload_args ?(get_vmtype) ?(ctx) t1 t2 f1 f2 = - let get_vmtype = match get_vmtype with - | None -> (fun f -> f) +let same_overload_args ?(get_vmtype) t1 t2 f1 f2 = + let f_transform = match get_vmtype with | Some f -> f + | None -> (fun t -> t) in - if List.length f1.cf_params <> List.length f2.cf_params then - Different - else - let amb_funs = - match ctx with - | None -> false - | Some ctx -> not (distinguishes_funs_as_params ctx) in - let rec follow_skip_null t = match t with - | TMono r -> - (match r.tm_type with - | Some t -> follow_skip_null t - | _ -> t) - | TLazy f -> - follow_skip_null (lazy_type f) - | TAbstract ({ a_path = [],"Null" } as a, [p]) -> - TAbstract(a,[follow p]) - | TType (t,tl) -> - follow_skip_null (apply_params t.t_params tl t.t_type) - | _ -> t + let f_eq t1 t2 = type_iseq (f_transform t1) (f_transform t2) in + let compare_type_params () = + let rec loop params1 params2 = match params1,params2 with + | [],[] -> + true + | (n1,t1) :: params1,(n2,t2) :: params2 -> + let constraints_equal t1 t2 = match follow t1,t2 with + | TInst({cl_kind = KTypeParameter tl1},_),TInst({cl_kind = KTypeParameter tl2},_) -> + Ast.safe_for_all2 f_eq tl1 tl2 + | _ -> + false + in + n1 = n2 && constraints_equal t1 t2 && loop params1 params2 + | [],_ + | _,[] -> + false + in + loop f1.cf_params f2.cf_params in - let compare_type t1 t2 = - (if type_iseq t1 t2 then - Same - else if amb_funs && type_iseq (ambiguate_funs t1) (ambiguate_funs t2) then - Impl_conflict - else - Different) in - let compare_arg t1 t2 = - let t1 = get_vmtype (follow_skip_null t1) in - let t2 = get_vmtype (follow_skip_null t2) in - match t1, t2 with - | TType _, TType _ -> compare_type t1 t2 - | TType _, _ - | _, TType _ -> Different - | _ -> compare_type t1 t2 + let compare_arguments tl1 tl2 = + let rec loop tl1 tl2 = match tl1,tl2 with + | [],[] -> + true + | (n1,o1,t1) :: tl1,(n2,o2,t2) :: tl2 -> + (* TODO: do we want to compare n and o here? *) + f_eq t1 t2 && loop tl1 tl2 + | _ -> + false + in + loop tl1 tl2 in + let compare_types () = + let t1 = follow (apply_params f1.cf_params (List.map (fun (_,t) -> t) f2.cf_params) t1) in + match t1,follow t2 with + | TFun(tl1,_),TFun(tl2,_) -> + compare_arguments tl1 tl2 + | _ -> + false + in + compare_type_params () && compare_types () - match follow (apply_params f1.cf_params (List.map (fun (_,t) -> t) f2.cf_params) t1), follow t2 with - | TFun(a1,_), TFun(a2,_) -> - let rec loop args1 args2 = - match args1, args2 with - | [], [] -> Same - | [], _ | _, [] -> Different - | (_,_,t1) :: rest1, (_,_,t2) :: rest2 -> - match compare_arg t1 t2 with - | Same -> loop rest1 rest2 - | result -> result - in - loop a1 a2 - | _ -> die "" __LOC__ - -let same_overload_args ?(get_vmtype) t1 t2 f1 f2 = - compare_overload_args ?get_vmtype t1 t2 f1 f2 <> Different - -(** retrieves all overloads from class c and field i, as (Type.t * tclass_field) list *) -let rec get_overloads c i = - let ret = try - let f = PMap.find i c.cl_fields in - match f.cf_kind with +let collect_overloads map c i = + let acc = ref [] in + let rec loop map c = + let maybe_add cf = + let t = map cf.cf_type in + if not (List.exists (fun (t2,cf2) -> same_overload_args t t2 cf cf2) !acc) then acc := (t,cf) :: !acc + in + begin try + let cf = PMap.find i c.cl_fields in + begin match cf.cf_kind with | Var _ -> - (* @:libType may generate classes that have a variable field in a superclass of an overloaded method *) - [] + () | Method _ -> - (f.cf_type, f) :: (List.map (fun f -> f.cf_type, f) f.cf_overloads) - with | Not_found -> [] + maybe_add cf; + List.iter maybe_add cf.cf_overloads + end; + with Not_found -> + () + end; + match c.cl_super with + | None when (has_class_flag c CInterface) -> + List.iter (fun (c,tl) -> + let tl = List.map map tl in + loop (fun t -> apply_params c.cl_params tl (map t)) c + ) c.cl_implements + | None -> + () + | Some (c,tl) -> + let tl = List.map map tl in + loop (fun t -> apply_params c.cl_params tl (map t)) c in - let rsup = match c.cl_super with - | None when c.cl_interface -> - let ifaces = List.concat (List.map (fun (c,tl) -> - List.map (fun (t,f) -> apply_params c.cl_params tl t, f) (get_overloads c i) - ) c.cl_implements) in - ret @ ifaces - | None -> ret - | Some (c,tl) -> - ret @ ( List.map (fun (t,f) -> apply_params c.cl_params tl t, f) (get_overloads c i) ) - in - ret @ (List.filter (fun (t,f) -> not (List.exists (fun (t2,f2) -> same_overload_args t t2 f f2) ret)) rsup) + loop map c; + List.rev !acc + +let get_overloads (com : Common.context) c i = + try + Hashtbl.find com.overload_cache (c.cl_path,i) + with Not_found -> + let l = collect_overloads (fun t -> t) c i in + Hashtbl.add com.overload_cache (c.cl_path,i) l; + l (** Overload resolution **) module Resolution = @@ -135,7 +130,7 @@ struct **) let rec rate_conv cacc tfun targ = match simplify_t tfun, simplify_t targ with - | TInst({ cl_interface = true } as cf, tlf), TInst(ca, tla) -> + | TInst(cf, tlf), TInst(ca, tla) when (has_class_flag cf CInterface) -> (* breadth-first *) let stack = ref [0,ca,tla] in let cur = ref (0, ca,tla) in @@ -211,7 +206,7 @@ struct raise Not_found let is_best arg1 arg2 = - (List.for_all2 (fun v1 v2 -> + (Ast.safe_for_all2 (fun v1 v2 -> v1 <= v2) arg1 arg2) && (List.exists2 (fun v1 v2 -> v1 < v2) @@ -219,7 +214,7 @@ struct let rec rm_duplicates acc ret = match ret with | [] -> acc - | ( el, t, _ ) :: ret when List.exists (fun (_,t2,_) -> type_iseq t t2) acc -> + | fcc :: ret when List.exists (fun fcc2 -> type_iseq fcc.fc_type fcc2.fc_type) acc -> rm_duplicates acc ret | r :: ret -> rm_duplicates (r :: acc) ret @@ -230,21 +225,25 @@ struct "( " ^ (String.concat "," (List.map (fun (i,i2) -> string_of_int i ^ ":" ^ string_of_int i2) rate)) ^ " ) => " ^ (s_type (print_context()) t) ) rated) - let count_optionals elist = - List.fold_left (fun acc (_,is_optional) -> if is_optional then acc + 1 else acc) 0 elist + let count_optionals t = + match follow t with + | TFun(args,_) -> + List.fold_left (fun acc (_,is_optional,_) -> if is_optional then acc + 1 else acc) 0 args + | _ -> + 0 let rec fewer_optionals acc compatible = match acc, compatible with | _, [] -> acc | [], c :: comp -> fewer_optionals [c] comp - | (elist_acc, _, _) :: _, ((elist, _, _) as cur) :: comp -> - let acc_opt = count_optionals elist_acc in - let comp_opt = count_optionals elist in + | fcc_acc :: _, fcc :: comp -> + let acc_opt = count_optionals fcc_acc.fc_type in + let comp_opt = count_optionals fcc.fc_type in if acc_opt = comp_opt then - fewer_optionals (cur :: acc) comp + fewer_optionals (fcc :: acc) comp else if acc_opt < comp_opt then fewer_optionals acc comp else - fewer_optionals [cur] comp + fewer_optionals [fcc] comp let reduce_compatible compatible = match fewer_optionals [] (rm_duplicates [] compatible) with | [] -> [] @@ -253,8 +252,8 @@ struct (* convert compatible into ( rate * compatible_type ) list *) let rec mk_rate acc elist args = match elist, args with | [], [] -> acc - | (_,true) :: elist, _ :: args -> mk_rate acc elist args - | (e,false) :: elist, (n,o,t) :: args -> + | _ :: elist, (_,true,_) :: args -> mk_rate acc elist args + | e :: elist, (n,o,t) :: args -> (* if the argument is an implicit cast, we need to start with a penalty *) (* The penalty should be higher than any other implicit cast - other than Dynamic *) (* since Dynamic has a penalty of max_int, we'll impose max_int - 1 to it *) @@ -267,9 +266,9 @@ struct in let rated = ref [] in - List.iter (function - | (elist,TFun(args,ret),d) -> (try - rated := ( (elist,TFun(args,ret),d), mk_rate [] elist args ) :: !rated + List.iter (fun fcc -> match fcc.fc_type with + | TFun(args,ret) -> (try + rated := ( fcc, mk_rate [] fcc.fc_args args ) :: !rated with | Not_found -> ()) | _ -> die "" __LOC__ ) compatible; diff --git a/src/codegen/swfLoader.ml b/src/codegen/swfLoader.ml index 58a464d8..26ae20cd 100644 --- a/src/codegen/swfLoader.ml +++ b/src/codegen/swfLoader.ml @@ -16,6 +16,7 @@ along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. *) +open Extlib_leftovers open Swf open As3 open As3hl @@ -46,7 +47,7 @@ let tp_dyn = { tpackage = []; tname = "Dynamic"; tparams = []; tsub = None; } let ct_dyn = CTPath tp_dyn let ct_rest = CTPath { - tpackage = ["haxe"; "extern"]; + tpackage = ["haxe"]; tname = "Rest"; tparams = [TPType (ct_dyn,null_pos)]; tsub = None; @@ -422,8 +423,8 @@ let build_class com c file = d_name = path.tname,null_pos; d_doc = None; d_params = []; - d_meta = [(Meta.Enum,[],null_pos);(Meta.Native,[(EConst (String(native_path,SDoubleQuotes)),null_pos)],null_pos)]; - d_flags = [AbExtern; AbOver (real_type,pos); AbFrom (real_type,pos)]; + d_meta = [(Meta.Native,[(EConst (String(native_path,SDoubleQuotes)),null_pos)],null_pos)]; + d_flags = [AbEnum;AbExtern; AbOver (real_type,pos); AbFrom (real_type,pos)]; d_data = constr; } in (path.tpackage, [(EAbstract abstract_data,pos)]) diff --git a/src/compiler/displayOutput.ml b/src/compiler/displayOutput.ml index c5d1e1d5..8d9f66b5 100644 --- a/src/compiler/displayOutput.ml +++ b/src/compiler/displayOutput.ml @@ -201,7 +201,7 @@ let print_signature tl display_arg = ) tl in let jo = JObject [ "signatures",JArray siginf; - "activeParameter",JInt display_arg; + "activeParameter",JInt (arg_index tl 0 display_arg); "activeSignature",JInt 0; ] in string_of_json jo @@ -229,42 +229,33 @@ let handle_display_argument com file_pos pre_compilation did_something = did_something := true; (try Memory.display_memory com with e -> prerr_endline (Printexc.get_backtrace ())); | "diagnostics" -> - Common.define com Define.NoCOpt; com.display <- DisplayMode.create (DMDiagnostics []); Parser.display_mode := DMDiagnostics []; | _ -> let file, pos = try ExtString.String.split file_pos "@" with _ -> failwith ("Invalid format: " ^ file_pos) in let file = unquote file in - let file_unique = Path.UniqueKey.create file in + let file_unique = com.file_keys#get file in let pos, smode = try ExtString.String.split pos "@" with _ -> pos,"" in let mode = match smode with | "position" -> - Common.define com Define.NoCOpt; DMDefinition | "usage" -> - Common.define com Define.NoCOpt; DMUsage (false,false,false) (*| "rename" -> - Common.define com Define.NoCOpt; DMUsage true*) | "package" -> DMPackage | "type" -> - Common.define com Define.NoCOpt; DMHover | "toplevel" -> DMDefault | "module-symbols" -> - Common.define com Define.NoCOpt; DMModuleSymbols None; | "diagnostics" -> - Common.define com Define.NoCOpt; DMDiagnostics [file_unique]; | "statistics" -> - Common.define com Define.NoCOpt; DMStatistics | "signature" -> - Common.define com Define.NoCOpt; DMSignature | "" -> DMDefault @@ -274,7 +265,6 @@ let handle_display_argument com file_pos pre_compilation did_something = | "resolve" -> DMResolve arg | "workspace-symbols" -> - Common.define com Define.NoCOpt; DMModuleSymbols (Some arg) | _ -> DMDefault @@ -430,8 +420,8 @@ let process_global_display_mode com tctx = let l = cs#get_context_files ((Define.get_signature com.defines) :: (match com.get_macros() with None -> [] | Some com -> [Define.get_signature com.defines])) in List.fold_left (fun acc (file_key,cfile) -> let file = cfile.CompilationServer.c_file_path in - if (filter <> None || DisplayPosition.display_position#is_in_file file) then - (file,DocumentSymbols.collect_module_symbols (filter = None) (cfile.c_package,cfile.c_decls)) :: acc + if (filter <> None || DisplayPosition.display_position#is_in_file (com.file_keys#get file)) then + (file,DocumentSymbols.collect_module_symbols (Some (file,get_module_name_of_cfile file cfile)) (filter = None) (cfile.c_package,cfile.c_decls)) :: acc else acc ) [] l diff --git a/src/compiler/haxe.ml b/src/compiler/haxe.ml index 2e5ae591..89dfd0a7 100644 --- a/src/compiler/haxe.ml +++ b/src/compiler/haxe.ml @@ -41,7 +41,7 @@ trailing l means list (but we also use natural plurals such as "metas") semantic suffixes may be used freely (e.g. e1, e_if, e') *) - +open Extlib_leftovers open Printf open Common open DisplayTypes.DisplayMode @@ -558,7 +558,8 @@ let handle_display ctx tctx display_file_dot_path = if ctx.com.display.dms_exit_during_typing then begin if ctx.has_next || ctx.has_error then raise Abort; (* If we didn't find a completion point, load the display file in macro mode. *) - ignore(load_display_module_in_macro tctx display_file_dot_path true); + if com.display_information.display_module_has_macro_defines then + ignore(load_display_module_in_macro tctx display_file_dot_path true); let no_completion_point_found = "No completion point was found" in match com.json_out with | Some _ -> (match ctx.com.display.dms_kind with @@ -677,7 +678,7 @@ let rec process_params create pl = and init ctx = let usage = Printf.sprintf - "Haxe Compiler %s - (C)2005-2020 Haxe Foundation\nUsage: haxe%s [options] [hxml files...]\n" + "Haxe Compiler %s - (C)2005-2020 Haxe Foundation\nUsage: haxe%s [options] [hxml files and dot paths...]\n" (s_version true) (if Sys.os_type = "Win32" then ".exe" else "") in let com = ctx.com in @@ -715,10 +716,10 @@ try in (* category, official names, deprecated names, arg spec, usage hint, doc *) let basic_args_spec = [ - ("Target",["--js"],["-js"],Arg.String (Initialize.set_platform com Js),"","compile code to JavaScript file"); - ("Target",["--lua"],["-lua"],Arg.String (Initialize.set_platform com Lua),"","compile code to Lua file"); - ("Target",["--swf"],["-swf"],Arg.String (Initialize.set_platform com Flash),"","compile code to Flash SWF file"); - ("Target",["--neko"],["-neko"],Arg.String (Initialize.set_platform com Neko),"","compile code to Neko Binary"); + ("Target",["--js"],["-js"],Arg.String (Initialize.set_platform com Js),"","generate JavaScript code into target file"); + ("Target",["--lua"],["-lua"],Arg.String (Initialize.set_platform com Lua),"","generate Lua code into target file"); + ("Target",["--swf"],["-swf"],Arg.String (Initialize.set_platform com Flash),"","generate Flash SWF bytecode into target file"); + ("Target",["--neko"],["-neko"],Arg.String (Initialize.set_platform com Neko),"","generate Neko bytecode into target file"); ("Target",["--php"],["-php"],Arg.String (fun dir -> classes := (["php"],"Boot") :: !classes; Initialize.set_platform com Php dir; @@ -729,7 +730,7 @@ try ("Target",["--cppia"],["-cppia"],Arg.String (fun file -> Common.define com Define.Cppia; Initialize.set_platform com Cpp file; - ),"","generate Cppia code into target file"); + ),"","generate Cppia bytecode into target file"); ("Target",["--cs"],["-cs"],Arg.String (fun dir -> cp_libs := "hxcs" :: !cp_libs; Initialize.set_platform com Cs dir; @@ -743,13 +744,13 @@ try Common.define com Define.Jvm; jvm_flag := true; Initialize.set_platform com Java dir; - ),"","generate JVM bytecode into target file"); + ),"","generate JVM bytecode into target file"); ("Target",["--python"],["-python"],Arg.String (fun dir -> Initialize.set_platform com Python dir; - ),"","generate Python code as target file"); + ),"","generate Python code into target file"); ("Target",["--hl"],["-hl"],Arg.String (fun file -> Initialize.set_platform com Hl file; - ),"","compile HL code as target file"); + ),"","generate HashLink .hl bytecode or .c code into target file"); ("Target",[],["-x"], Arg.String (fun cl -> let cpath = Path.parse_type_path cl in (match com.main_class with @@ -855,10 +856,10 @@ try ),"","use the SWF library for type checking"); ("Target-specific",["--java-lib"],["-java-lib"],Arg.String (fun file -> add_native_lib file false; - ),"","add an external JAR or class directory library"); + ),"","add an external JAR or directory of JAR files"); ("Target-specific",["--java-lib-extern"],[],Arg.String (fun file -> add_native_lib file true; - ),"","use an external JAR or class directory library for type checking"); + ),"","use an external JAR or directory of JAR files for type checking"); ("Target-specific",["--net-lib"],["-net-lib"],Arg.String (fun file -> add_native_lib file false; ),"[@std]","add an external .NET DLL file"); @@ -946,7 +947,7 @@ try ("Compilation",["-C";"--cwd"],[], Arg.String (fun dir -> (* This is handled by process_params, but passed through so we know we did something. *) did_something := true; - ),"

","set current working directory"); + ),"","set current working directory"); ("Compilation",["--haxelib-global"],[], Arg.Unit (fun () -> ()),"","pass --global argument to haxelib"); ] in let args_callback cl = @@ -1097,7 +1098,7 @@ with ctx.messages <- []; end else begin error ctx (Printf.sprintf "You cannot access the %s package while %s (for %s)" pack (if pf = "macro" then "in a macro" else "targeting " ^ pf) (s_type_path m) ) p; - List.iter (error ctx " referenced here") (List.rev pl); + List.iter (error ctx (Error.compl_msg "referenced here")) (List.rev pl); end | Error.Error (m,p) -> error ctx (Error.error_msg m) p diff --git a/src/compiler/server.ml b/src/compiler/server.ml index 2a73e9b9..326d9e23 100644 --- a/src/compiler/server.ml +++ b/src/compiler/server.ml @@ -123,8 +123,8 @@ let current_stdin = ref None let parse_file cs com file p = let cc = CommonCache.get_cache cs com in let ffile = Path.get_full_path file - and fkey = Path.UniqueKey.create file in - let is_display_file = DisplayPosition.display_position#is_in_file ffile in + and fkey = com.file_keys#get file in + let is_display_file = DisplayPosition.display_position#is_in_file (com.file_keys#get ffile) in match is_display_file, !current_stdin with | true, Some stdin when Common.defined com Define.DisplayStdin -> TypeloadParse.parse_file_from_string com file p stdin @@ -287,7 +287,7 @@ let check_module sctx ctx m p = let com = ctx.Typecore.com in let cc = CommonCache.get_cache sctx.cs com in let content_changed m file = - let fkey = Path.UniqueKey.create file in + let fkey = ctx.com.file_keys#get file in try let cfile = cc#find_file fkey in (* We must use the module path here because the file path is absolute and would cause @@ -331,7 +331,7 @@ let check_module sctx ctx m p = match load m.m_path p with | None -> loop l | Some _ -> - if Path.UniqueKey.create file <> Path.UniqueKey.create m.m_extra.m_file then begin + if com.file_keys#get file <> (Path.UniqueKey.lazy_key m.m_extra.m_file) then begin if sctx.verbose then print_endline ("Library file was changed for " ^ s_type_path m.m_path); (* TODO *) raise Not_found; end @@ -358,12 +358,13 @@ let check_module sctx ctx m p = | _ -> false in let check_file () = - if file_time m.m_extra.m_file <> m.m_extra.m_time then begin - if has_policy CheckFileContentModification && not (content_changed m m.m_extra.m_file) then begin - ServerMessage.unchanged_content com "" m.m_extra.m_file; + let file = Path.UniqueKey.lazy_path m.m_extra.m_file in + if file_time file <> m.m_extra.m_time then begin + if has_policy CheckFileContentModification && not (content_changed m file) then begin + ServerMessage.unchanged_content com "" file; end else begin ServerMessage.not_cached com "" m; - if m.m_extra.m_kind = MFake then Hashtbl.remove Typecore.fake_modules (Path.UniqueKey.create m.m_extra.m_file); + if m.m_extra.m_kind = MFake then Hashtbl.remove Typecore.fake_modules (Path.UniqueKey.lazy_key m.m_extra.m_file); raise Not_found; end end @@ -385,7 +386,7 @@ let check_module sctx ctx m p = m.m_extra.m_mark <- mark; if old_mark <= start_mark then begin if not (has_policy NoCheckShadowing) then check_module_path(); - if not (has_policy NoCheckFileTimeModification) || file_extension m.m_extra.m_file <> "hx" then check_file(); + if not (has_policy NoCheckFileTimeModification) || file_extension (Path.UniqueKey.lazy_path m.m_extra.m_file) <> "hx" then check_file(); end; if not (has_policy NoCheckDependencies) then check_dependencies(); None diff --git a/src/compiler/serverMessage.ml b/src/compiler/serverMessage.ml index c9af325d..95100800 100644 --- a/src/compiler/serverMessage.ml +++ b/src/compiler/serverMessage.ml @@ -71,7 +71,7 @@ let changed_directories com tabs dirs = let module_path_changed com tabs (m,time,file) = if config.print_module_path_changed then print_endline (Printf.sprintf "%smodule path might have changed: %s\n\twas: %2.0f %s\n\tnow: %2.0f %s" - (sign_string com) (s_type_path m.m_path) m.m_extra.m_time m.m_extra.m_file time file) + (sign_string com) (s_type_path m.m_path) m.m_extra.m_time (Path.UniqueKey.lazy_path m.m_extra.m_file) time file) let not_cached com tabs m = if config.print_not_cached then print_endline (Printf.sprintf "%s%s not cached (%s)" (sign_string com) (s_type_path m.m_path) "modified") diff --git a/src/context/abstractCast.ml b/src/context/abstractCast.ml index 8a57ef80..802df0df 100644 --- a/src/context/abstractCast.ml +++ b/src/context/abstractCast.ml @@ -4,6 +4,7 @@ open Ast open Type open Typecore open Error +open CallUnification let cast_stack = new_rec_stack() @@ -25,7 +26,7 @@ let rec make_static_call ctx c cf a pl args t p = end else Typecore.make_static_call ctx c cf (apply_params a.a_params pl) args t p -and do_check_cast ctx tleft eright p = +and do_check_cast ctx uctx tleft eright p = let recurse cf f = (* Without this special check for macro @:from methods we will always get "Recursive implicit cast" error @@ -40,8 +41,7 @@ and do_check_cast ctx tleft eright p = if cf == ctx.curfield || rec_stack_memq cf cast_stack then error "Recursive implicit cast" p; rec_stack_loop cast_stack cf f () in - let find a tl f = - let tcf,cf = f() in + let make (a,tl,(tcf,cf)) = if (Meta.has Meta.MultiType a.a_meta) then mk_cast eright tleft p else match a.a_impl with @@ -51,7 +51,7 @@ and do_check_cast ctx tleft eright p = ) | None -> die "" __LOC__ in - if type_iseq tleft eright.etype then + if type_iseq_custom uctx tleft eright.etype then eright else begin let rec loop stack tleft tright = @@ -61,24 +61,24 @@ and do_check_cast ctx tleft eright p = let stack = (tleft,tright) :: stack in match follow tleft,follow tright with | TAbstract(a1,tl1),TAbstract(a2,tl2) -> - Abstract.find_to_from find a1 tl1 a2 tl2 tleft eright.etype + make (Abstract.find_to_from uctx eright.etype tleft a2 tl2 a1 tl1) | TAbstract(a,tl),_ -> - begin try find a tl (fun () -> Abstract.find_from a tl eright.etype tleft) + begin try make (a,tl,Abstract.find_from uctx eright.etype a tl) with Not_found -> let rec loop2 tcl = match tcl with | tc :: tcl -> - if not (type_iseq tc tleft) then loop stack (apply_params a.a_params tl tc) tright + if not (type_iseq_custom uctx tc tleft) then loop stack (apply_params a.a_params tl tc) tright else loop2 tcl | [] -> raise Not_found in loop2 a.a_from end | _,TAbstract(a,tl) -> - begin try find a tl (fun () -> Abstract.find_to a tl tleft) + begin try make (a,tl,Abstract.find_to uctx tleft a tl) with Not_found -> let rec loop2 tcl = match tcl with | tc :: tcl -> - if not (type_iseq tc tright) then loop stack tleft (apply_params a.a_params tl tc) + if not (type_iseq_custom uctx tc tright) then loop stack tleft (apply_params a.a_params tl tc) else loop2 tcl | [] -> raise Not_found in @@ -91,13 +91,15 @@ and do_check_cast ctx tleft eright p = loop [] tleft eright.etype end -and cast_or_unify_raise ctx tleft eright p = +and cast_or_unify_raise ctx ?(uctx=None) tleft eright p = + let uctx = match uctx with + | None -> default_unification_context + | Some uctx -> uctx + in try - (* can't do that anymore because this might miss macro calls (#4315) *) - (* if ctx.com.display <> DMNone then raise Not_found; *) - do_check_cast ctx tleft eright p + do_check_cast ctx uctx tleft eright p with Not_found -> - unify_raise ctx eright.etype tleft p; + unify_raise_custom uctx ctx eright.etype tleft p; eright and cast_or_unify ctx tleft eright p = @@ -114,7 +116,7 @@ let find_array_access_raise ctx a pl e1 e2o p = match cfl with | [] -> raise Not_found | cf :: cfl -> - let monos = List.map (fun _ -> mk_mono()) cf.cf_params in + let monos = List.map (fun _ -> spawn_monomorph ctx p) cf.cf_params in let map t = apply_params a.a_params pl (apply_params cf.cf_params monos t) in let check_constraints () = List.iter2 (fun m (name,t) -> match follow t with @@ -124,7 +126,7 @@ let find_array_access_raise ctx a pl e1 e2o p = ) monos cf.cf_params; in let get_ta() = - if has_meta Meta.Impl cf.cf_meta then ta + if has_class_field_flag cf CfImpl then ta else TAbstract(a,pl) in match follow (map cf.cf_type) with @@ -162,55 +164,39 @@ let find_array_access ctx a tl e1 e2o p = 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 m = mk_mono() in - let tl = match Meta.get Meta.MultiType a.a_meta with - | _,[],_ -> pl - | _,el,_ -> - let relevant = Hashtbl.create 0 in - List.iter (fun e -> - let rec loop f e = match fst e with - | EConst(Ident s) -> - Hashtbl.replace relevant s f - | EMeta((Meta.Custom ":followWithAbstracts",_,_),e1) -> - loop Abstract.follow_with_abstracts e1; - | _ -> - error "Type parameter expected" (pos e) - in - loop (fun t -> t) e - ) el; - let tl = List.map2 (fun (n,_) t -> - try - (Hashtbl.find relevant n) t - with Not_found -> - if not (has_mono t) then t - else t_dynamic - ) a.a_params pl in - if com.platform = Globals.Js && a.a_path = (["haxe";"ds"],"Map") then begin match tl with - | t1 :: _ -> - let stack = ref [] in - let rec loop t = - if List.exists (fun t2 -> fast_eq t t2) !stack then - t - else begin - stack := t :: !stack; - match follow t with - | TAbstract ({ a_path = [],"Class" },_) -> - error (Printf.sprintf "Cannot use %s as key type to Map because Class is not comparable on JavaScript" (s_type (print_context()) t1)) p; - | TEnum(en,tl) -> - PMap.iter (fun _ ef -> ignore(loop ef.ef_type)) en.e_constrs; - Type.map loop t - | t -> - Type.map loop t - end - in - ignore(loop t1) - | _ -> die "" __LOC__ - end; - tl - 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 + | t1 :: _ -> + let stack = ref [] in + let rec loop t = + if List.exists (fun t2 -> fast_eq t t2) !stack then + t + else begin + stack := t :: !stack; + match follow t with + | TAbstract ({ a_path = [],"Class" },_) -> + error (Printf.sprintf "Cannot use %s as key type to Map because Class is not comparable on JavaScript" (s_type (print_context()) t1)) p; + | TEnum(en,tl) -> + PMap.iter (fun _ ef -> ignore(loop ef.ef_type)) en.e_constrs; + Type.map loop t + | t -> + Type.map loop t + end + in + ignore(loop t1) + | _ -> die "" __LOC__ + end; let _,cf = try - Abstract.find_to a tl m + let t = Abstract.find_to uctx m a tl in + if List.exists (fun t -> has_mono t) definitive_types then begin + let at = apply_params a.a_params pl a.a_this in + let st = s_type (print_context()) at in + error ("Type parameters of multi type abstracts must be known (for " ^ st ^ ")") p + end; + t with Not_found -> let at = apply_params a.a_params pl a.a_this in let st = s_type (print_context()) at in @@ -253,7 +239,7 @@ let handle_abstract_casts ctx e = let rec find_abstract e t = match follow t,e.eexpr with | TAbstract(a,pl),_ when Meta.has Meta.MultiType a.a_meta -> a,pl,e | _,TCast(e1,None) -> find_abstract e1 e1.etype - | _,TLocal {v_extra = Some(_,Some e')} -> + | _,TLocal {v_extra = Some({v_expr = Some e'})} -> begin match follow e'.etype with | TAbstract(a,pl) when Meta.has Meta.MultiType a.a_meta -> a,pl,mk (TCast(e,None)) e'.etype e.epos | _ -> raise Not_found @@ -272,21 +258,43 @@ let handle_abstract_casts ctx e = begin try let fa = quick_field m fname in let get_fun_type t = match follow t with - | TFun(_,tr) as tf -> tf,tr + | TFun(args,tr) as tf -> tf,args,tr | _ -> raise Not_found in - let tf,tr = match fa with + let tf,args,tr = match fa with | FStatic(_,cf) -> get_fun_type cf.cf_type | FInstance(c,tl,cf) -> get_fun_type (apply_params c.cl_params tl cf.cf_type) | FAnon cf -> get_fun_type cf.cf_type | _ -> raise Not_found in + let maybe_cast e t p = + if type_iseq e.etype t then e + else mk (TCast(e,None)) t p + in let ef = mk (TField({e2 with etype = m},fa)) tf e2.epos in + let el = + if has_meta Meta.MultiType a.a_meta then + let rec add_casts orig_args args el = + match orig_args, args, el with + | _, [], _ | _, _, [] -> el + | [], (_,_,t) :: args, e :: el -> + maybe_cast e t e.epos :: add_casts orig_args args el + | (_,_,orig_t) :: orig_args, (_,_,t) :: args, e :: el -> + let t = + match follow t with + | TMono _ -> (match follow orig_t with TDynamic _ -> orig_t | _ -> t) + | _ -> t + in + maybe_cast e t e.epos :: add_casts orig_args args el + in + match follow e1.etype with + | TFun (orig_args,_) -> add_casts orig_args args el + | _ -> el + else + el + in let ecall = make_call ctx ef el tr e.epos in - if not (type_iseq ecall.etype e.etype) then - mk (TCast(ecall,None)) e.etype e.epos - else - ecall + maybe_cast ecall e.etype e.epos with Not_found -> (* quick_field raises Not_found if m is an abstract, we have to replicate the 'using' call here *) match follow m with @@ -305,4 +313,6 @@ let handle_abstract_casts ctx e = | _ -> Type.map_expr (loop ctx) e in - loop ctx e \ No newline at end of file + loop ctx e +;; +Typecore.cast_or_unify_raise_ref := cast_or_unify_raise \ No newline at end of file diff --git a/src/context/common.ml b/src/context/common.ml index 7e2b8e0a..71e8b2a2 100644 --- a/src/context/common.ml +++ b/src/context/common.ml @@ -16,7 +16,7 @@ along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. *) - +open Extlib_leftovers open Ast open CompilationServer open Type @@ -61,7 +61,14 @@ let compiler_message_string msg = else begin let error_printer file line = Printf.sprintf "%s:%d:" file line in let epos = Lexer.get_error_pos error_printer p in - let str = String.concat ("\n" ^ epos ^ " : ") (ExtString.String.nsplit str "\n") in + let str = + let lines = + match (ExtString.String.nsplit str "\n") with + | first :: rest -> first :: List.map Error.compl_msg rest + | l -> l + in + String.concat ("\n" ^ epos ^ " : ") lines + in Printf.sprintf "%s : %s" epos str end @@ -171,6 +178,8 @@ type platform_config = { 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 *) @@ -221,6 +230,18 @@ class compiler_callbacks = object(self) method get_null_safety_report = null_safety_report end +class file_keys = object(self) + val cache = Hashtbl.create 0 + + method get file = + try + Hashtbl.find cache file + with Not_found -> + let key = Path.UniqueKey.create file in + Hashtbl.add cache file key; + key +end + type shared_display_information = { mutable diagnostics_messages : (string * pos * DisplayTypes.DiagnosticsKind.t * DisplayTypes.DiagnosticsSeverity.t) list; } @@ -228,6 +249,7 @@ type shared_display_information = { type display_information = { mutable unresolved_identifiers : (string * pos * (string * CompletionItem.t * int) list) list; mutable display_module_has_macro_defines : bool; + mutable module_diagnostics : DisplayTypes.module_diagnostics list; } (* This information is shared between normal and macro context. *) @@ -290,12 +312,14 @@ type context = { mutable get_macros : unit -> context option; mutable run_command : string -> int; file_lookup_cache : (string,string option) Hashtbl.t; + file_keys : file_keys; readdir_cache : (string * string,(string array) option) Hashtbl.t; parser_cache : (string,(type_def * pos) list) Hashtbl.t; module_to_file : (path,string) Hashtbl.t; cached_macros : (path * string,(((string * bool * t) list * t * tclass * Type.tclass_field) * module_def)) Hashtbl.t; mutable stored_typed_exprs : (int, texpr) PMap.t; pass_debug_messages : string DynArray.t; + overload_cache : ((path * string),(Type.t * tclass_field) list) Hashtbl.t; (* output *) mutable file : string; mutable flash_version : float; @@ -389,6 +413,7 @@ let default_config = pf_this_before_super = true; pf_supports_threads = false; pf_supports_unicode = true; + pf_supports_rest_args = false; pf_exceptions = { ec_native_throws = []; ec_native_catches = []; @@ -416,6 +441,7 @@ let get_config com = pf_capture_policy = if es6 then CPNone else CPLoopVars; pf_reserved_type_paths = [([],"Object");([],"Error")]; pf_this_before_super = not es6; (* cannot access `this` before `super()` when generating ES6 classes *) + pf_supports_rest_args = true; pf_exceptions = { default_config.pf_exceptions with ec_native_throws = [ ["js";"lib"],"Error"; @@ -435,6 +461,7 @@ let get_config com = pf_static = false; pf_capture_policy = CPLoopVars; pf_uses_utf16 = false; + pf_supports_rest_args = true; } | Neko -> { @@ -455,6 +482,7 @@ let get_config com = pf_capture_policy = CPLoopVars; pf_can_skip_non_nullable_argument = false; pf_reserved_type_paths = [([],"Object");([],"Error")]; + pf_supports_rest_args = true; pf_exceptions = { default_config.pf_exceptions with ec_native_throws = [ ["flash";"errors"],"Error"; @@ -475,6 +503,7 @@ let get_config com = default_config with pf_static = false; pf_uses_utf16 = false; + pf_supports_rest_args = true; pf_exceptions = { default_config.pf_exceptions with ec_native_throws = [ ["php"],"Throwable"; @@ -511,6 +540,7 @@ let get_config com = pf_pad_nulls = true; pf_overload = true; pf_supports_threads = true; + pf_supports_rest_args = true; pf_exceptions = { ec_native_throws = [ ["cs";"system"],"Exception"; @@ -536,6 +566,7 @@ let get_config com = pf_pad_nulls = true; pf_overload = true; pf_supports_threads = true; + pf_supports_rest_args = true; pf_this_before_super = false; pf_exceptions = { default_config.pf_exceptions with ec_native_throws = [ @@ -564,6 +595,8 @@ let get_config com = pf_static = false; pf_capture_policy = CPLoopVars; pf_uses_utf16 = false; + pf_supports_threads = true; + pf_supports_rest_args = true; pf_exceptions = { default_config.pf_exceptions with ec_native_throws = [ ["python";"Exceptions"],"BaseException"; @@ -626,6 +659,7 @@ let create version s_version args = display_information = { unresolved_identifiers = []; display_module_has_macro_defines = false; + module_diagnostics = []; }; sys_args = args; debug = false; @@ -667,6 +701,7 @@ let create version s_version args = get_messages = (fun() -> []); filter_messages = (fun _ -> ()); pass_debug_messages = DynArray.create(); + overload_cache = Hashtbl.create 0; basic = { tvoid = m; tint = m; @@ -677,6 +712,7 @@ let create version s_version args = tarray = (fun _ -> die "" __LOC__); }; file_lookup_cache = Hashtbl.create 0; + file_keys = new file_keys; readdir_cache = Hashtbl.create 0; module_to_file = Hashtbl.create 0; stored_typed_exprs = PMap.empty; @@ -704,12 +740,14 @@ let clone com = display_information = { unresolved_identifiers = []; display_module_has_macro_defines = false; + module_diagnostics = []; }; defines = { values = com.defines.values; defines_signature = com.defines.defines_signature; }; native_libs = create_native_libs(); + overload_cache = Hashtbl.create 0; } let file_time file = Extc.filetime file @@ -806,7 +844,7 @@ let rec has_feature com f = | t when field = "*" -> not (has_dce com) || (match t with TAbstractDecl a -> Meta.has Meta.ValueUsed a.a_meta | _ -> Meta.has Meta.Used (t_infos t).mt_meta) - | TClassDecl ({cl_extern = true} as c) when com.platform <> Js || cl <> "Array" && cl <> "Math" -> + | TClassDecl c when (has_class_flag c CExtern) && (com.platform <> Js || cl <> "Array" && cl <> "Math") -> not (has_dce com) || Meta.has Meta.Used (try PMap.find field c.cl_statics with Not_found -> PMap.find field c.cl_fields).cf_meta | TClassDecl c -> PMap.exists field c.cl_statics || PMap.exists field c.cl_fields @@ -831,77 +869,100 @@ let platform ctx p = ctx.platform = p let platform_name_macro com = if defined com Define.Macro then "macro" else platform_name com.platform -let normalize_dir_separator path = - if is_windows then String.map (fun c -> if c = '/' then '\\' else c) path - else path +let cache_directory ctx class_path dir f_dir = + let platform_ext = "." ^ (platform_name_macro ctx) + and is_loading_core_api = defined ctx Define.CoreApi in + let remove_extension file = + try String.sub file 0 (String.rindex file '.') + with Not_found -> file + in + let extension file = + try + let dot_pos = String.rindex file '.' in + String.sub file dot_pos (String.length file - dot_pos) + with Not_found -> file + in + let dir_listing = + try Some (Sys.readdir dir); + with Sys_error _ -> None + in + Hashtbl.add ctx.readdir_cache (class_path,dir) dir_listing; + (* + This function is invoked for each file in the `dir`. + Each file is checked if it's specific for current platform + (e.g. ends with `.js.hx` while compiling for JS). + If it's not platform-specific: + Check the lookup cache and if the file is not there store full file path in the cache. + If the file is platform-specific: + Store the full file path in the lookup cache probably replacing the cached path to a + non-platform-specific file. + *) + let prepare_file file_own_name = + let relative_to_classpath = if f_dir = "." then file_own_name else f_dir ^ "/" ^ file_own_name in + (* `representation` is how the file is referenced to. E.g. when it's deduced from a module path. *) + let is_platform_specific,representation = + (* Platform specific file extensions are not allowed for loading @:coreApi types. *) + if is_loading_core_api then + false,relative_to_classpath + else begin + let ext = extension relative_to_classpath in + let second_ext = extension (remove_extension relative_to_classpath) in + (* The file contains double extension and the secondary one matches current platform *) + if platform_ext = second_ext then + true,(remove_extension (remove_extension relative_to_classpath)) ^ ext + else + false,relative_to_classpath + end + in + (* + Store current full path for `representation` if + - we're loading @:coreApi + - or this is a platform-specific file for `representation` + - this `representation` was never found before + *) + if is_loading_core_api || is_platform_specific || not (Hashtbl.mem ctx.file_lookup_cache representation) then begin + let full_path = if dir = "." then file_own_name else dir ^ "/" ^ file_own_name in + Hashtbl.replace ctx.file_lookup_cache representation (Some full_path); + end + in + Option.may (Array.iter prepare_file) dir_listing let find_file ctx f = try match Hashtbl.find ctx.file_lookup_cache f with | None -> raise Exit | Some f -> f - with Exit -> + with + | Exit -> raise Not_found + | Not_found when Path.is_absolute_path f -> + Hashtbl.add ctx.file_lookup_cache f (Some f); + f | Not_found -> - let remove_extension file = - try String.sub file 0 (String.rindex file '.') - with Not_found -> file - in - let extension file = - try - let dot_pos = String.rindex file '.' in - String.sub file dot_pos (String.length file - dot_pos) - with Not_found -> file - in - let f_dir = Filename.dirname f - and platform_ext = "." ^ (platform_name_macro ctx) - and is_core_api = defined ctx Define.CoreApi in + let f_dir = Filename.dirname f in let rec loop had_empty = function | [] when had_empty -> raise Not_found | [] -> loop true [""] | p :: l -> let file = p ^ f in let dir = Filename.dirname file in + (* If we have seen the directory before, we can assume that the file isn't in there because the else case + below would have added it to `file_lookup_cache`, which we check before we get here. *) if Hashtbl.mem ctx.readdir_cache (p,dir) then loop (had_empty || p = "") l else begin - let found = ref "" in - let dir_listing = - try Some (Sys.readdir dir); - with Sys_error _ -> None - in - Hashtbl.add ctx.readdir_cache (p,dir) dir_listing; - let normalized_f = normalize_dir_separator f in - Option.may - (Array.iter (fun file_name -> - let current_f = if f_dir = "." then file_name else f_dir ^ "/" ^ file_name in - let pf,current_f = - if is_core_api then false,current_f - else begin - let ext = extension current_f in - let pf_ext = extension (remove_extension current_f) in - if platform_ext = pf_ext then - true,(remove_extension (remove_extension current_f)) ^ ext - else - false,current_f - end - in - let is_cached = Hashtbl.mem ctx.file_lookup_cache current_f in - if is_core_api || pf || not is_cached then begin - let full_path = if dir = "." then file_name else dir ^ "/" ^ file_name in - if is_cached then - Hashtbl.remove ctx.file_lookup_cache current_f; - Hashtbl.add ctx.file_lookup_cache current_f (Some full_path); - if normalize_dir_separator current_f = normalized_f then - found := full_path; - end - )) - dir_listing; - if !found <> "" then !found - else loop (had_empty || p = "") l + cache_directory ctx p dir f_dir; + (* Caching might have located the file we're looking for, so check the lookup cache again. *) + try + begin match Hashtbl.find ctx.file_lookup_cache f with + | Some f -> f + | None -> raise Not_found + end + with Not_found -> + loop (had_empty || p = "") l end in - let r = (try Some (loop false ctx.class_path) with Not_found -> None) in + let r = try Some (loop false ctx.class_path) with Not_found -> None in Hashtbl.add ctx.file_lookup_cache f r; match r with | None -> raise Not_found @@ -1042,7 +1103,11 @@ let is_legacy_completion com = match com.json_out with let get_entry_point com = Option.map (fun path -> let m = List.find (fun m -> m.m_path = path) com.modules in - let c = ExtList.List.find_map (fun t -> match t with TClassDecl c when c.cl_path = path -> Some c | _ -> None) m.m_types in + let c = + match m.m_statics with + | Some c when (PMap.mem "main" c.cl_statics) -> c + | _ -> Option.get (ExtList.List.find_map (fun t -> match t with TClassDecl c when c.cl_path = path -> Some c | _ -> None) m.m_types) + in let e = Option.get com.main in (* must be present at this point *) (snd path, c, e) ) com.main_class diff --git a/src/context/compilationServer.ml b/src/context/compilationServer.ml index 2e277eea..b9df0d71 100644 --- a/src/context/compilationServer.ml +++ b/src/context/compilationServer.ml @@ -163,7 +163,7 @@ class cache = object(self) method taint_modules file_key = Hashtbl.iter (fun _ cc -> Hashtbl.iter (fun _ m -> - if m.m_extra.m_file_key() = file_key then m.m_extra.m_dirty <- Some m.m_path + if Path.UniqueKey.lazy_key m.m_extra.m_file = file_key then m.m_extra.m_dirty <- Some m.m_path ) cc#get_modules ) contexts diff --git a/src/context/display/deprecationCheck.ml b/src/context/display/deprecationCheck.ml index fb1da87d..2d238283 100644 --- a/src/context/display/deprecationCheck.ml +++ b/src/context/display/deprecationCheck.ml @@ -121,4 +121,9 @@ let run_on_expr ?(force=false) com e = if_enabled ~force com (fun() -> run_on_ex let run_on_field ?(force=false) com cf = if_enabled ~force com (fun() -> run_on_field com cf) -let run ?(force=false) com = if_enabled ~force com (fun() -> run com) \ No newline at end of file +let run ?(force=false) com = if_enabled ~force com (fun() -> run com) + +let check_is com name meta p = + () + (* if name = "is" && not (Meta.has Meta.Deprecated meta) then + warn_deprecation com "Using \"is\" as an identifier is deprecated" p *) \ No newline at end of file diff --git a/src/context/display/diagnostics.ml b/src/context/display/diagnostics.ml index 9fea1c72..07d4a96a 100644 --- a/src/context/display/diagnostics.ml +++ b/src/context/display/diagnostics.ml @@ -7,12 +7,11 @@ open Display open DisplayTypes.DisplayMode open DisplayTypes open DisplayException -open DiagnosticsTypes let add_removable_code ctx s p prange = ctx.removable_code <- (s,p,prange) :: ctx.removable_code -let is_diagnostics_run p = DiagnosticsPrinter.is_diagnostics_file p.pfile +let is_diagnostics_run com p = DiagnosticsPrinter.is_diagnostics_file (com.file_keys#get p.pfile) let find_unused_variables com e = let vars = Hashtbl.create 0 in @@ -105,9 +104,10 @@ let prepare com = dead_blocks = Hashtbl.create 0; diagnostics_messages = []; unresolved_identifiers = []; + missing_fields = PMap.empty; } in List.iter (function - | TClassDecl c when DiagnosticsPrinter.is_diagnostics_file c.cl_pos.pfile -> + | TClassDecl c when DiagnosticsPrinter.is_diagnostics_file (com.file_keys#get c.cl_pos.pfile) -> List.iter (prepare_field dctx com) c.cl_ordered_fields; List.iter (prepare_field dctx com) c.cl_ordered_statics; (match c.cl_constructor with None -> () | Some cf -> prepare_field dctx com cf); @@ -122,7 +122,7 @@ let prepare com = ParserEntry.is_true (ParserEntry.eval defines e) in Hashtbl.iter (fun file_key cfile -> - if DisplayPosition.display_position#is_in_file cfile.CompilationServer.c_file_path then begin + if DisplayPosition.display_position#is_in_file (com.file_keys#get cfile.CompilationServer.c_file_path) then begin let dead_blocks = cfile.CompilationServer.c_pdi.pd_dead_blocks in let dead_blocks = List.filter (fun (_,e) -> not (is_true display_defines e)) dead_blocks in try @@ -147,8 +147,18 @@ let prepare com = let b' = PMap.find p dctx.import_positions in b' := true end - ) m.m_extra.m_display.m_import_positions - ) com.modules + ) m.m_extra.m_display.m_import_positions; + ) com.modules; + List.iter (function + | MissingFields mf -> + let p = mf.mf_pos in + begin try + let _,l = PMap.find p dctx.missing_fields in + l := mf :: !l + with Not_found -> + dctx.missing_fields <- PMap.add p (mf.mf_on,ref [mf]) dctx.missing_fields + end + ) com.display_information.module_diagnostics in process_modules com; begin match com.get_macros() with @@ -161,7 +171,7 @@ let prepare com = dctx let secure_generated_code ctx e = - if is_diagnostics_run e.epos then mk (TMeta((Meta.Extern,[],e.epos),e)) e.etype e.epos else e + if is_diagnostics_run ctx.com e.epos then mk (TMeta((Meta.Extern,[],e.epos),e)) e.etype e.epos else e let print com = let dctx = prepare com in diff --git a/src/context/display/diagnosticsPrinter.ml b/src/context/display/diagnosticsPrinter.ml index a0561f61..25c99bbb 100644 --- a/src/context/display/diagnosticsPrinter.ml +++ b/src/context/display/diagnosticsPrinter.ml @@ -1,17 +1,18 @@ open Globals +open Common open Json open DisplayTypes open DiagnosticsKind open DisplayTypes -open DiagnosticsTypes +open Type +open Genjson type t = DiagnosticsKind.t * pos -let is_diagnostics_file file = - let key = Path.UniqueKey.create file in +let is_diagnostics_file file_key = match (!Parser.display_mode) with | DMDiagnostics [] -> true - | DMDiagnostics file_keys -> List.exists (fun key' -> key = key') file_keys + | DMDiagnostics file_keys -> List.exists (fun key' -> file_key = key') file_keys | _ -> false module UnresolvedIdentifierSuggestion = struct @@ -30,7 +31,7 @@ open CompletionModuleType let json_of_diagnostics dctx = let diag = Hashtbl.create 0 in - let add dk p sev args = + let add append dk p sev args = let file = if p = null_pos then p.pfile else Path.get_real_path p.pfile in let diag = try Hashtbl.find diag file @@ -39,11 +40,24 @@ let json_of_diagnostics dctx = Hashtbl.add diag file d; d in - if not (Hashtbl.mem diag p) then + if append || not (Hashtbl.mem diag p) then Hashtbl.add diag p (dk,p,sev,args) in + let file_keys = new Common.file_keys in let add dk p sev args = - if p = null_pos || is_diagnostics_file p.pfile then add dk p sev args + let append = match dk with + | DKUnusedImport + | DKRemovableCode + | DKDeprecationWarning + | DKInactiveBlock -> + false + | DKUnresolvedIdentifier + | DKCompilerError + | DKParserError + | DKMissingFields -> + true + in + if p = null_pos || is_diagnostics_file (file_keys#get p.pfile) then add append dk p sev args in List.iter (fun (s,p,suggestions) -> let suggestions = ExtList.List.filter_map (fun (s,item,r) -> @@ -65,18 +79,82 @@ let json_of_diagnostics dctx = ) suggestions in add DKUnresolvedIdentifier p DiagnosticsSeverity.Error (JArray suggestions); ) dctx.unresolved_identifiers; - PMap.iter (fun p r -> - if not !r then add DKUnusedImport p DiagnosticsSeverity.Warning (JArray []) - ) dctx.import_positions; List.iter (fun (s,p,kind,sev) -> add kind p sev (JString s) ) (List.rev dctx.diagnostics_messages); - List.iter (fun (s,p,prange) -> - add DKRemovableCode p DiagnosticsSeverity.Warning (JObject ["description",JString s;"range",if prange = null_pos then JNull else Genjson.generate_pos_as_range prange]) - ) dctx.removable_code; + PMap.iter (fun p (mt,mfl) -> + let jctx = create_context GMMinimum in + let all_fields = ref [] in + let scope cf = + if has_class_field_flag cf CfStatic then CFSStatic else CFSMember + in + let create mf = + let kind,args = match mf.mf_cause with + | AbstractParent(csup,tl) -> + "AbstractParent",jobject [ + "parent",generate_type_path_with_params jctx csup.cl_module.m_path csup.cl_path tl csup.cl_meta; + ] + | ImplementedInterface(ci,tl) -> + "ImplementedInterface",jobject [ + "parent",generate_type_path_with_params jctx ci.cl_module.m_path ci.cl_path tl ci.cl_meta; + ] + | PropertyAccessor(cf,is_getter) -> + "PropertyAccessor",jobject [ + "property",generate_class_field jctx (scope cf) cf; + "isGetter",jbool is_getter; + ] + | FieldAccess -> + "FieldAccess",jobject [] + | FinalFields cfl -> + "FinalFields",jobject [ + "fields",jarray (List.map (fun cf -> generate_class_field jctx (scope cf) cf) cfl) + ] + in + let current_fields = ref [] in + let map_field (cf,t,ct) = + let cf = {cf with cf_overloads = []} in + if List.exists (fun (t2,cf2) -> cf.cf_name = cf2.cf_name && Overloads.same_overload_args t t2 cf cf2) !current_fields then + None + else begin + (* With multiple interfaces there can be duplicates, which would be bad for the "Implement all" code action. *) + let unique = not (List.exists (fun (t2,cf2) -> cf.cf_name = cf2.cf_name && Overloads.same_overload_args t t2 cf cf2) !all_fields) in + current_fields := (t,cf) :: !current_fields; + all_fields := (t,cf) :: !all_fields; + Some (jobject [ + "field",generate_class_field jctx (scope cf) cf; + "type",CompletionType.generate_type jctx ct; + "unique",jbool unique; + ]) + end + in + let fields = ExtList.List.filter_map map_field mf.mf_fields in + jobject [ + "fields",jarray fields; + "cause",jobject [ + "kind",jstring kind; + "args",args + ] + ] + in + (* cl_interfaces is reversed, let's reverse the order again here *) + let l = List.map create (List.rev !mfl) in + let j = jobject [ + "moduleType",generate_module_type jctx mt; + "moduleFile",jstring (Path.UniqueKey.lazy_path (t_infos mt).mt_module.m_extra.m_file); + "entries",jarray l + ] in + add DKMissingFields p DiagnosticsSeverity.Error j + ) dctx.missing_fields; + (* non-append from here *) Hashtbl.iter (fun _ (s,p) -> add DKDeprecationWarning p DiagnosticsSeverity.Warning (JString s); ) DeprecationCheck.warned_positions; + PMap.iter (fun p r -> + if not !r then add DKUnusedImport p DiagnosticsSeverity.Warning (JArray []) + ) dctx.import_positions; + List.iter (fun (s,p,prange) -> + add DKRemovableCode p DiagnosticsSeverity.Warning (JObject ["description",JString s;"range",if prange = null_pos then JNull else Genjson.generate_pos_as_range prange]) + ) dctx.removable_code; Hashtbl.iter (fun file ranges -> List.iter (fun (p,e) -> let jo = JObject [ diff --git a/src/context/display/diagnosticsTypes.ml b/src/context/display/diagnosticsTypes.ml deleted file mode 100644 index 209b3498..00000000 --- a/src/context/display/diagnosticsTypes.ml +++ /dev/null @@ -1,10 +0,0 @@ -open Globals -open Ast - -type diagnostics_context = { - mutable removable_code : (string * pos * pos) list; - mutable import_positions : (pos,bool ref) PMap.t; - mutable dead_blocks : (Path.UniqueKey.t,(pos * expr) list) Hashtbl.t; - mutable unresolved_identifiers : (string * pos * (string * CompletionItem.t * int) list) list; - mutable diagnostics_messages : (string * pos * DisplayTypes.DiagnosticsKind.t * DisplayTypes.DiagnosticsSeverity.t) list; -} \ No newline at end of file diff --git a/src/context/display/display.ml b/src/context/display/display.ml index eed8a308..03c47de4 100644 --- a/src/context/display/display.ml +++ b/src/context/display/display.ml @@ -72,13 +72,13 @@ module ExprPreprocessing = struct match fst e with | EVars vl when is_annotated (pos e) && is_completion -> let rec loop2 acc mark vl = match vl with - | ((s,pn),final,tho,eo) as v :: vl -> + | v :: vl -> if mark then loop2 (v :: acc) mark vl - else if is_annotated pn then + else if is_annotated (snd v.ev_name) then (* If the name is the display position, mark the expression *) loop2 (v :: acc) true vl - else begin match eo with + else begin match v.ev_expr with | None -> (* If there is no expression, we don't have to do anything. Should the display position be on the type-hint, it will @@ -90,13 +90,13 @@ module ExprPreprocessing = struct we cannot determine that correctly without knowing its position. Note: We know `e` itself isn't the display position because this entire algorithm is bottom-up and it would be marked already if it was. *) - let p0 = match tho with + let p0 = match v.ev_type with | Some (_,pt) -> pt - | None -> pn + | None -> snd v.ev_name in let p = {p0 with pmax = (pos e).pmin} in let e = if is_annotated p then annotate_marked e else e in - loop2 (((s,pn),final,tho,(Some e)) :: acc) mark vl + loop2 ({ v with ev_expr = Some e } :: acc) mark vl end | [] -> List.rev acc,mark @@ -189,14 +189,14 @@ module ExprPreprocessing = struct raise Exit | EMeta((Meta.Markup,_,_),(EConst(String _),p)) when is_annotated p -> annotate_marked e - | EConst (String _) when (not (Lexer.is_fmt_string (pos e)) || !Parser.was_auto_triggered) && is_annotated (pos e) && is_completion -> + | EConst (String (_,q)) when ((q <> SSingleQuotes) || !Parser.was_auto_triggered) && is_annotated (pos e) && is_completion -> (* TODO: check if this makes any sense *) raise Exit | EConst(Regexp _) when is_annotated (pos e) && is_completion -> raise Exit | EVars vl when is_annotated (pos e) -> (* We only want to mark EVars if we're on a var name. *) - if List.exists (fun ((_,pn),_,_,_) -> is_annotated pn) vl then + if List.exists (fun v -> is_annotated (snd v.ev_name)) vl then annotate_marked e else raise Exit @@ -262,8 +262,8 @@ end let get_expected_name with_type = match with_type with | WithType.Value (Some src) | WithType.WithType(_,Some src) -> (match src with - | WithType.FunctionArgument name -> Some name - | WithType.StructureField name -> Some name + | WithType.FunctionArgument si -> Some si.si_name + | WithType.StructureField si -> Some si .si_name | WithType.ImplicitReturn -> None ) | _ -> None diff --git a/src/context/display/displayEmitter.ml b/src/context/display/displayEmitter.ml index a820f60f..9fc0209a 100644 --- a/src/context/display/displayEmitter.ml +++ b/src/context/display/displayEmitter.ml @@ -56,12 +56,19 @@ let rec display_type ctx t p = | _ -> () -let check_display_type ctx t p = +let check_display_type ctx t path = let add_type_hint () = - ctx.g.type_hints <- (ctx.m.curmod.m_extra.m_display,p,t) :: ctx.g.type_hints; + ctx.g.type_hints <- (ctx.m.curmod.m_extra.m_display,pos path,t) :: ctx.g.type_hints; in let maybe_display_type () = - if ctx.is_display_file && display_position#enclosed_in p then + if ctx.is_display_file && display_position#enclosed_in (pos path) then + let p = + match path with + | ({ tpackage = pack; tname = name; tsub = sub },p) -> + let strings = match sub with None -> name :: pack | Some s -> s :: name :: pack in + let length = String.length (String.concat "." strings) in + { p with pmax = p.pmin + length } + in display_type ctx t p in add_type_hint(); @@ -108,7 +115,7 @@ let display_field ctx origin scope cf p = match ctx.com.display.dms_kind with in ReferencePosition.set (name,cf.cf_name_pos,kind) | DMHover -> - let cf = if Meta.has Meta.Impl cf.cf_meta then + let cf = if has_class_field_flag cf CfImpl then prepare_using_field cf else cf diff --git a/src/context/display/displayException.ml b/src/context/display/displayException.ml index b8224269..4eb7f5a0 100644 --- a/src/context/display/displayException.ml +++ b/src/context/display/displayException.ml @@ -5,34 +5,7 @@ open CompletionItem open Type open Genjson -type hover_result = { - hitem : CompletionItem.t; - hpos : pos; - hexpected : WithType.t option; -} - -type fields_result = { - fitems : CompletionItem.t list; - fkind : CompletionResultKind.t; - fsubject : completion_subject; -} - -type signature_kind = - | SKCall - | SKArrayAccess - -type kind = - | DisplayDiagnostics of DiagnosticsTypes.diagnostics_context - | Statistics of string - | ModuleSymbols of string - | Metadata of string - | DisplaySignatures of (((tsignature * CompletionType.ct_function) * documentation) list * int * int * signature_kind) option - | DisplayHover of hover_result option - | DisplayPositions of pos list - | DisplayFields of fields_result option - | DisplayPackage of string list - -exception DisplayException of kind +exception DisplayException of display_exception_kind let raise_diagnostics s = raise (DisplayException(DisplayDiagnostics s)) let raise_statistics s = raise (DisplayException(Statistics s)) @@ -170,6 +143,20 @@ let fields_to_json ctx fields kind subj = in jobject fl +let arg_index signatures signature_index param_index = + try + let args,_ = fst (fst (List.nth signatures signature_index)) in + let rec loop args index = + match args with + | [] -> param_index + | [_,_,t] when index < param_index && ExtType.is_rest (follow t) -> index + | arg :: _ when index = param_index -> param_index + | _ :: args -> loop args (index + 1) + in + loop args 0 + with Invalid_argument _ -> + param_index + let to_json ctx de = match de with | Statistics _ @@ -193,7 +180,7 @@ let to_json ctx de = in jobject [ "activeSignature",jint isig; - "activeParameter",jint iarg; + "activeParameter",jint (arg_index sigs isig iarg); "signatures",jlist fsig sigs; "kind",jint sigkind; ] @@ -207,10 +194,11 @@ let to_json ctx de = in let ctx = Genjson.create_context GMFull in let generate_name kind = - let i, name = named_source_kind kind in + let i,si = named_source_kind kind in jobject [ - "name",jstring name; + "name",jstring si.si_name; "kind",jint i; + "doc",(match si.si_doc with None -> jnull | Some s -> jstring s); ] in let expected = match hover.hexpected with @@ -219,10 +207,14 @@ let to_json ctx de = :: (match src with | None -> [] | Some ImplicitReturn -> [] - | Some src -> ["name",generate_name src]) + | Some src -> [ + "name",generate_name src; + ]) ) | Some(Value(Some ((FunctionArgument name | StructureField name) as src))) -> - jobject ["name",generate_name src] + jobject [ + "name",generate_name src; + ] | _ -> jnull in jobject [ diff --git a/src/context/display/displayFields.ml b/src/context/display/displayFields.ml index 4b8ea688..7cf8aa39 100644 --- a/src/context/display/displayFields.ml +++ b/src/context/display/displayFields.ml @@ -19,10 +19,12 @@ open Ast open Globals open Error +open Common open Typecore open Type open CompletionItem open ClassFieldOrigin +open DisplayTypes open Display let get_submodule_fields ctx path = @@ -50,11 +52,11 @@ let collect_static_extensions ctx items e p = | (c,_) :: l -> let rec dup t = Type.map dup t in let acc = List.fold_left (fun acc f -> - if Meta.has Meta.NoUsing f.cf_meta || Meta.has Meta.NoCompletion f.cf_meta || Meta.has Meta.Impl f.cf_meta || PMap.mem f.cf_name acc then + if Meta.has Meta.NoUsing f.cf_meta || Meta.has Meta.NoCompletion f.cf_meta || has_class_field_flag f CfImpl || PMap.mem f.cf_name acc then acc else begin let f = { f with cf_type = opt_type f.cf_type } in - let monos = List.map (fun _ -> mk_mono()) f.cf_params in + let monos = List.map (fun _ -> spawn_monomorph ctx p) f.cf_params in let map = apply_params f.cf_params monos in match follow (map f.cf_type) with | TFun((_,_,TType({t_path=["haxe";"macro"], "ExprOf"}, [t])) :: args, ret) @@ -111,7 +113,7 @@ let collect ctx e_ast e dk with_type p = | "get_" | "set_" -> false | _ -> can_access ctx c cf stat end else - (not stat || not (Meta.has Meta.Impl cf.cf_meta)) && + (not stat || not (has_class_field_flag cf CfImpl)) && can_access ctx c cf stat in let make_class_field origin cf = @@ -120,7 +122,36 @@ let collect ctx e_ast e dk with_type p = in let rec loop items t = let is_new_item items name = not (PMap.mem name items) in + let rec browse_interfaces c acc = + List.fold_left (fun acc (c,tl) -> + let acc = List.fold_left (fun acc cf -> + if is_new_item acc cf.cf_name then begin + let origin = Parent(TClassDecl c) in + let item = make_class_field origin cf in + PMap.add cf.cf_name item acc + end else + acc + ) acc c.cl_ordered_fields in + List.fold_left (fun acc (c,_) -> browse_interfaces c acc) acc c.cl_implements + ) acc c.cl_implements + in match follow t with + | TMono m -> + begin match Monomorph.classify_constraints m with + | CStructural(fields,is_open) -> + if not is_open then begin + Monomorph.close m; + begin match m.tm_type with + | None -> items + | Some t -> loop items t + end + end else + loop items (mk_anon ~fields (ref Closed)) + | CTypes tl -> + items + | CUnknown -> + items + end | TInst ({cl_kind = KTypeParameter tl},_) -> (* Type parameters can access the fields of their constraints *) List.fold_left (fun acc t -> loop acc t) items tl @@ -128,14 +159,20 @@ let collect ctx e_ast e dk with_type p = (* For classes, browse the hierarchy *) let fields = TClass.get_all_fields c0 tl in Display.merge_core_doc ctx (TClassDecl c0); - PMap.foldi (fun k (c,cf) acc -> + let acc = PMap.foldi (fun k (c,cf) acc -> if should_access c cf false && is_new_item acc cf.cf_name then begin let origin = if c == c0 then Self(TClassDecl c) else Parent(TClassDecl c) in let item = make_class_field origin cf in PMap.add k item acc end else acc - ) fields items + ) fields items in + let acc = if has_class_flag c0 CExtern && Meta.has Meta.LibType c0.cl_meta then + browse_interfaces c0 acc + else + acc + in + acc | TEnum _ -> let t = ctx.g.do_load_type_def ctx p {tpackage=[];tname="EnumValue";tsub=None;tparams=[]} in begin match t with @@ -154,7 +191,7 @@ let collect ctx e_ast e dk with_type p = Display.merge_core_doc ctx (TAbstractDecl a); (* Abstracts should show all their @:impl fields minus the constructor. *) let items = List.fold_left (fun acc cf -> - if Meta.has Meta.Impl cf.cf_meta && not (Meta.has Meta.Enum cf.cf_meta) && should_access c cf false && is_new_item acc cf.cf_name then begin + if has_class_field_flag cf CfImpl && not (has_class_field_flag cf CfEnum) && should_access c cf false && is_new_item acc cf.cf_name then begin let origin = Self(TAbstractDecl a) in let cf = prepare_using_field cf in let cf = if tl = [] then cf else {cf with cf_type = apply_params a.a_params tl cf.cf_type} in @@ -208,7 +245,7 @@ let collect ctx e_ast e dk with_type p = if is_new_item acc name then begin let allow_static_abstract_access c cf = should_access c cf false && - (not (Meta.has Meta.Impl cf.cf_meta) || Meta.has Meta.Enum cf.cf_meta) + (not (has_class_field_flag cf CfImpl) || has_class_field_flag cf CfEnum) in let ct = CompletionType.from_type (get_import_status ctx) ~values:(get_value_meta cf.cf_meta) cf.cf_type in let add origin make_field = @@ -217,7 +254,7 @@ let collect ctx e_ast e dk with_type p = match !(an.a_status) with | Statics ({cl_kind = KAbstractImpl a} as c) -> if allow_static_abstract_access c cf then - let make = if Meta.has Meta.Enum cf.cf_meta then + let make = if has_class_field_flag cf CfEnum then (make_ci_enum_abstract_field a) else make_ci_class_field @@ -285,3 +322,86 @@ let collect ctx e_ast e dk with_type p = items @ get_submodule_fields ctx (List.tl sl,List.hd sl) with Exit | Not_found -> items + +let handle_missing_field_raise ctx tthis i mode with_type pfield = + let tret = match with_type with + | WithType.WithType(t,_) -> t + | WithType.Value _ -> mk_mono() + | WithType.NoValue -> + match mode with + | MCall _ -> ctx.t.tvoid + | MSet (Some e) -> + begin try + let e = type_expr ctx e WithType.value in + e.etype + with _ -> + raise Exit + end + | _ -> raise Exit + in + let t,kind = match mode with + | MCall el -> + begin try + let tl = List.mapi (fun i e -> + let name = match Expr.find_ident e with + | Some name -> name + | None -> Printf.sprintf "arg%i" i + in + let e = type_expr ctx e WithType.value in + (name,false,e.etype) + ) el in + (TFun(tl,tret),Method MethNormal) + with _ -> + raise Exit + end + | MGet -> + tret,Var {v_read = AccNormal;v_write = AccNo} + | MSet _ -> + tret,Var {v_read = AccNormal;v_write = AccNormal} + in + let cf = mk_field ~public:false i t pfield null_pos in + cf.cf_meta <- [Meta.CompilerGenerated,[],null_pos;Meta.NoCompletion,[],null_pos]; + cf.cf_kind <- kind; + let mt,scope,public = match follow tthis with + | TInst(c,_) -> TClassDecl c,CFSMember,not (can_access ctx c cf false) + | TEnum(en,_) -> TEnumDecl en,CFSMember,true + | TAbstract(a,_) -> TAbstractDecl a,CFSMember,true + | TAnon an -> + begin match !(an.a_status) with + | Statics c -> TClassDecl c,CFSStatic,not (can_access ctx c cf true) + | EnumStatics en -> TEnumDecl en,CFSStatic,true + | AbstractStatics a -> TAbstractDecl a,CFSStatic,true + | _ -> raise Exit + end + | _ -> + raise Exit + in + if public then add_class_field_flag cf CfPublic; + begin match scope with + | CFSStatic -> add_class_field_flag cf CfStatic + | _ -> () + end; + let diag = { + mf_pos = pfield; + mf_on = mt; + mf_fields = [(cf,t,CompletionItem.CompletionType.from_type (Display.get_import_status ctx) t)]; + mf_cause = FieldAccess; + } in + let display = ctx.com.display_information in + display.module_diagnostics <- MissingFields diag :: display.module_diagnostics + +let handle_missing_ident ctx i mode with_type p = + match ctx.curfun with + | FunStatic -> + let e_self = Texpr.Builder.make_static_this ctx.curclass p in + begin try + handle_missing_field_raise ctx e_self.etype i mode with_type p + with Exit -> + () + end + | _ -> + begin try + handle_missing_field_raise ctx ctx.tthis i mode with_type p + with Exit -> + () + end \ No newline at end of file diff --git a/src/context/display/displayJson.ml b/src/context/display/displayJson.ml index 65c7abc8..ba8bb1df 100644 --- a/src/context/display/displayJson.ml +++ b/src/context/display/displayJson.ml @@ -122,22 +122,18 @@ let handler = hctx.display#enable_display DMDefault; ); "display/definition", (fun hctx -> - Common.define hctx.com Define.NoCOpt; hctx.display#set_display_file false true; hctx.display#enable_display DMDefinition; ); "display/implementation", (fun hctx -> - Common.define hctx.com Define.NoCOpt; hctx.display#set_display_file false true; hctx.display#enable_display (DMImplementation); ); "display/typeDefinition", (fun hctx -> - Common.define hctx.com Define.NoCOpt; hctx.display#set_display_file false true; hctx.display#enable_display DMTypeDefinition; ); "display/references", (fun hctx -> - Common.define hctx.com Define.NoCOpt; hctx.display#set_display_file false true; match hctx.jsonrpc#get_opt_param (fun () -> hctx.jsonrpc#get_string_param "kind") "normal" with | "withBaseAndDescendants" -> @@ -148,7 +144,6 @@ let handler = hctx.display#enable_display (DMUsage (false,false,false)); ); "display/hover", (fun hctx -> - Common.define hctx.com Define.NoCOpt; hctx.display#set_display_file false true; hctx.display#enable_display DMHover; ); @@ -197,7 +192,7 @@ let handler = "server/moduleCreated", (fun hctx -> let file = hctx.jsonrpc#get_string_param "file" in let file = Path.get_full_path file in - let key = Path.UniqueKey.create file in + let key = hctx.com.file_keys#get file in let cs = hctx.display#get_cs in List.iter (fun cc -> Hashtbl.replace cc#get_removed_files key file @@ -221,7 +216,7 @@ let handler = ); "server/invalidate", (fun hctx -> let file = hctx.jsonrpc#get_string_param "file" in - let fkey = Path.UniqueKey.create file in + let fkey = hctx.com.file_keys#get file in let cs = hctx.display#get_cs in cs#taint_modules fkey; cs#remove_files fkey; diff --git a/src/context/display/displayPath.ml b/src/context/display/displayPath.ml index 21179e69..47a6cc4f 100644 --- a/src/context/display/displayPath.ml +++ b/src/context/display/displayPath.ml @@ -192,7 +192,7 @@ let handle_path_display ctx path p = (* We assume that we want to go to the module file, not a specific type which might not even exist anyway. *) let mt = ctx.g.do_load_module ctx (sl,s) p in - let p = { pfile = mt.m_extra.m_file; pmin = 0; pmax = 0} in + let p = { pfile = (Path.UniqueKey.lazy_path mt.m_extra.m_file); pmin = 0; pmax = 0} in raise_positions [p] | (IDKModule(sl,s),_),DMHover -> let m = ctx.g.do_load_module ctx (sl,s) p in diff --git a/src/context/display/displayTexpr.ml b/src/context/display/displayTexpr.ml index cfcaebdc..e7a686d1 100644 --- a/src/context/display/displayTexpr.ml +++ b/src/context/display/displayTexpr.ml @@ -66,6 +66,10 @@ let check_display_class ctx cc cfile c = check_display_field ctx sc c cf; DisplayEmitter.check_display_metadata ctx cf.cf_meta in + let check_field sc cf = + check_field sc cf; + List.iter (check_field sc) cf.cf_overloads + in match c.cl_kind with | KAbstractImpl a -> let sa = find_abstract_by_position cfile c.cl_name_pos in @@ -110,6 +114,16 @@ let check_display_abstract ctx cc cfile a = () ) sa.d_flags +let check_display_module_fields ctx cfile m = + Option.may (fun c -> + let sc = find_class_by_position cfile c.cl_name_pos in + List.iter (fun cf -> + if display_position#enclosed_in cf.cf_pos then + check_display_field ctx sc c cf; + DisplayEmitter.check_display_metadata ctx cf.cf_meta + ) c.cl_ordered_statics + ) m.m_statics + let check_display_module ctx cc cfile m = let imports = List.filter (function | (EImport _ | EUsing _),_ -> true @@ -132,14 +146,15 @@ let check_display_module ctx cc cfile m = check_display_abstract ctx cc cfile a end; DisplayEmitter.check_display_metadata ctx infos.mt_meta - ) m.m_types + ) m.m_types; + check_display_module_fields ctx cfile m let check_display_file ctx cs = match ctx.com.cache with | Some cc -> begin try let p = DisplayPosition.display_position#get in - let cfile = cc#find_file (Path.UniqueKey.create p.pfile) in + let cfile = cc#find_file (ctx.com.file_keys#get p.pfile) in let path = (cfile.c_package,get_module_name_of_cfile p.pfile cfile) in TypeloadParse.PdiHandler.handle_pdi ctx.com cfile.c_pdi; (* We have to go through type_module_hook because one of the module's dependencies could be diff --git a/src/context/display/displayToplevel.ml b/src/context/display/displayToplevel.ml index e11e87c2..3362383f 100644 --- a/src/context/display/displayToplevel.ml +++ b/src/context/display/displayToplevel.ml @@ -108,11 +108,11 @@ let explore_class_paths com timer class_paths recursive f_pack f_module = let read_class_paths com timer = explore_class_paths com timer (List.filter ((<>) "") com.class_path) true (fun _ -> ()) (fun file path -> (* Don't parse the display file as that would maybe overwrite the content from stdin with the file contents. *) - if not (DisplayPosition.display_position#is_in_file file) then begin + if not (DisplayPosition.display_position#is_in_file (com.file_keys#get file)) then begin let file,_,pack,_ = Display.parse_module' com path Globals.null_pos in match CompilationServer.get() with | Some cs when pack <> fst path -> - let file_key = Path.UniqueKey.create file in + let file_key = com.file_keys#get file in (CommonCache.get_cache cs com)#remove_file_for_real file_key | _ -> () @@ -223,7 +223,7 @@ let collect ctx tk with_type sort = let add_type mt = match mt with - | TClassDecl {cl_kind = KAbstractImpl _} -> () + | TClassDecl {cl_kind = KAbstractImpl _ | KModuleFields _} -> () | _ -> let path = (t_infos mt).mt_path in let mname = snd (t_infos mt).mt_module.m_path in @@ -251,7 +251,8 @@ let collect ctx tk with_type sort = | EEnum d -> fst d.d_name,List.mem EPrivate d.d_flags,d.d_meta | ETypedef d -> fst d.d_name,List.mem EPrivate d.d_flags,d.d_meta | EAbstract d -> fst d.d_name,List.mem AbPrivate d.d_flags,d.d_meta - | _ -> raise Exit + | EStatic d -> fst d.d_name,List.exists (fun (a,_) -> a = APrivate) d.d_flags,d.d_meta + | EImport _ | EUsing _ -> raise Exit in let path = Path.full_dot_path pack name tname in if not (path_exists cctx path) && not is_private && not (Meta.has Meta.NoCompletion meta) then begin @@ -323,7 +324,7 @@ let collect ctx tk with_type sort = | KAbstractImpl ({a_impl = Some c} as a) -> let origin = Self (TAbstractDecl a) in List.iter (fun cf -> - if Meta.has Meta.Impl cf.cf_meta then begin + if has_class_field_flag cf CfImpl then begin if ctx.curfun = FunStatic then () else begin let cf = prepare_using_field cf in @@ -339,11 +340,11 @@ let collect ctx tk with_type sort = (* enum constructors *) let rec enum_ctors t = match t with - | TAbstractDecl ({a_impl = Some c} as a) when Meta.has Meta.Enum a.a_meta && not (path_exists cctx a.a_path) && ctx.curclass != c -> + | TAbstractDecl ({a_impl = Some c} as a) when a.a_enum && not (path_exists cctx a.a_path) && ctx.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 (Meta.has Meta.Enum cf.cf_meta) && not (Meta.has Meta.NoCompletion cf.cf_meta) then + 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 -> @@ -380,7 +381,7 @@ let collect ctx tk with_type sort = 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 Meta.has Meta.Enum cf.cf_meta then make_ci_enum_abstract_field a else make_ci_class_field + 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 diff --git a/src/context/display/documentSymbols.ml b/src/context/display/documentSymbols.ml index b45c8e7d..705c8be1 100644 --- a/src/context/display/documentSymbols.ml +++ b/src/context/display/documentSymbols.ml @@ -2,7 +2,7 @@ open Ast open Globals open DisplayTypes.SymbolKind -let collect_module_symbols with_locals (pack,decls) = +let collect_module_symbols mname with_locals (pack,decls) = let l = DynArray.create() in let add name kind location parent deprecated = let si = DisplayTypes.SymbolInformation.make name kind location (if parent = "" then None else Some parent) deprecated in @@ -12,9 +12,9 @@ let collect_module_symbols with_locals (pack,decls) = let add name kind location = add name kind location parent in begin match e with | EVars vl -> - List.iter (fun ((s,p),_,_,eo) -> - add s Variable p false; - expr_opt parent eo + List.iter (fun v -> + add (fst v.ev_name) Variable (snd v.ev_name) false; + expr_opt parent v.ev_expr ) vl | ETry(e1,catches) -> expr parent e1; @@ -42,21 +42,21 @@ let collect_module_symbols with_locals (pack,decls) = expr_opt parent f.f_expr in let is_deprecated meta = Meta.has Meta.Deprecated meta in - let field parent parent_kind cff = - let field_parent = parent ^ "." ^ (fst cff.cff_name) in - let add_field kind = add (fst cff.cff_name) kind cff.cff_pos parent (is_deprecated cff.cff_meta) in - match cff.cff_kind with + let field' parent parent_kind cff_name cff_kind cff_access cff_pos cff_meta = + let field_parent = parent ^ "." ^ (fst cff_name) in + let add_field kind = add (fst cff_name) kind cff_pos parent (is_deprecated cff_meta) in + match cff_kind with | FVar(_,eo) -> add_field ( - if parent_kind = EnumAbstract && not (List.mem_assoc AStatic cff.cff_access) then EnumMember - else if (List.mem_assoc AInline cff.cff_access) then Constant + if parent_kind = EnumAbstract && not (List.mem_assoc AStatic cff_access) then EnumMember + else if (List.mem_assoc AInline cff_access) then Constant else Field ); if with_locals then expr_opt field_parent eo | FFun f -> add_field ( - if fst cff.cff_name = "new" then Constructor - else if ((parent_kind = EnumAbstract or parent_kind = Abstract) && Meta.has_one_of [Meta.Op; Meta.ArrayAccess; Meta.Resolve] cff.cff_meta) then Operator + if fst cff_name = "new" then Constructor + else if ((parent_kind = EnumAbstract or parent_kind = Abstract) && Meta.has_one_of [Meta.Op; Meta.ArrayAccess; Meta.Resolve] cff_meta) then Operator else Method ); if with_locals then func field_parent f @@ -64,13 +64,22 @@ let collect_module_symbols with_locals (pack,decls) = add_field Property; if with_locals then expr_opt field_parent eo in + let field parent parent_kind cff = + field' parent parent_kind cff.cff_name cff.cff_kind cff.cff_access cff.cff_pos cff.cff_meta + in + let type_decls = Hashtbl.create 0 in List.iter (fun (td,p) -> - let add_type d kind = - let string_of_path l = String.concat "." l in + let get_decl_path d = let module_name = Path.module_name_of_file p.pfile in let type_name = fst d.d_name in let is_primary_type = type_name = module_name in let type_path = if is_primary_type then pack else pack @ [module_name] in + type_path, type_name + in + let string_of_path l = String.concat "." l in + let add_type d kind = + let type_path, type_name = get_decl_path d in + Hashtbl.add type_decls type_name (); add type_name kind p (string_of_path type_path) (is_deprecated d.d_meta); string_of_path (type_path @ [type_name]) in @@ -95,10 +104,20 @@ let collect_module_symbols with_locals (pack,decls) = ignore(add_type d TypeAlias) ) | EAbstract d -> - let kind = if Meta.has Meta.Enum d.d_meta then EnumAbstract else Abstract in + let kind = if List.mem AbEnum d.d_flags then EnumAbstract else Abstract in let parent = add_type d kind in List.iter (field parent kind) d.d_data + | EStatic d -> + let path, name = get_decl_path d in + let dotpath = string_of_path path in + field' dotpath Class d.d_name d.d_data d.d_flags p d.d_meta ) decls; + begin match mname with + | Some(file,mname) when not (Hashtbl.mem type_decls mname) -> + add mname Module {pfile = file; pmin = 0; pmax = 0} (String.concat "." pack) false + | _ -> + () + end; l module Printer = struct diff --git a/src/context/display/statistics.ml b/src/context/display/statistics.ml index 881e89f3..b855660a 100644 --- a/src/context/display/statistics.ml +++ b/src/context/display/statistics.ml @@ -28,7 +28,7 @@ let collect_statistics ctx pos_filters with_expressions = try Hashtbl.find paths path with Not_found -> - let unique = Path.UniqueKey.create path in + let unique = ctx.com.file_keys#get path in Hashtbl.add paths path unique; unique ) @@ -55,29 +55,27 @@ let collect_statistics ctx pos_filters with_expressions = Hashtbl.replace symbols p kind; end in - let collect_overrides c = - List.iter (fun cf -> - let rec loop c = match c.cl_super with - | Some (c,_) -> - begin try - let cf' = PMap.find cf.cf_name c.cl_fields in - add_relation cf'.cf_name_pos (Overridden,cf.cf_name_pos) - with Not_found -> - () - end; - loop c - | _ -> + let check_override c cf = + let rec loop c = match c.cl_super with + | Some (c,_) -> + begin try + let cf' = PMap.find cf.cf_name c.cl_fields in + add_relation cf'.cf_name_pos (Overridden,cf.cf_name_pos) + with Not_found -> () - in - loop c - ) c.cl_overrides + end; + loop c + | _ -> + () + in + loop c in let collect_implementations c = let memo = Hashtbl.create 0 in let rec loop c1 = if not (Hashtbl.mem memo c1.cl_path) then begin Hashtbl.add memo c1.cl_path true; - if c1.cl_interface then + if (has_class_flag c1 CInterface) then add_relation c.cl_name_pos (Extended,c1.cl_name_pos) else begin add_relation c.cl_name_pos (Implemented,c1.cl_name_pos); @@ -224,7 +222,7 @@ let collect_statistics ctx pos_filters with_expressions = let f = function | TClassDecl c -> check_module c.cl_module; - declare (if c.cl_interface then (SKInterface c) else (SKClass c)) c.cl_name_pos; + declare (if (has_class_flag c CInterface) then (SKInterface c) else (SKClass c)) c.cl_name_pos; begin match c.cl_super with | None -> () | Some (c',_) -> @@ -234,8 +232,7 @@ let collect_statistics ctx pos_filters with_expressions = in loop c' end; - collect_overrides c; - if c.cl_interface then + if (has_class_flag c CInterface) then collect_implementations c; let field cf = if cf.cf_pos.pmin > c.cl_name_pos.pmin then declare (SKField (cf,Some c.cl_path)) cf.cf_name_pos; @@ -245,7 +242,10 @@ let collect_statistics ctx pos_filters with_expressions = end in Option.may field c.cl_constructor; - List.iter field c.cl_ordered_fields; + List.iter (fun cf -> + if has_class_field_flag cf CfOverride then check_override c cf; + field cf; + ) c.cl_ordered_fields; List.iter field c.cl_ordered_statics; | TEnumDecl en -> check_module en.e_module; diff --git a/src/context/display/syntaxExplorer.ml b/src/context/display/syntaxExplorer.ml index d85dfca8..3d86e1cf 100644 --- a/src/context/display/syntaxExplorer.ml +++ b/src/context/display/syntaxExplorer.ml @@ -60,9 +60,9 @@ let find_in_syntax symbols (pack,decls) = expr e1; check KAnyField s; | EVars vl -> - List.iter (fun (_,_,tho,eo) -> - Option.may type_hint tho; - expr_opt eo + List.iter (fun v -> + Option.may type_hint v.ev_type; + expr_opt v.ev_expr ) vl; | ECast(e1,tho) -> expr e1; @@ -97,7 +97,9 @@ let find_in_syntax symbols (pack,decls) = expr_opt f.f_expr and field cff = check KClassField (fst cff.cff_name); - match cff.cff_kind with + field_kind cff.cff_kind + and field_kind cff_kind = + match cff_kind with | FVar(tho,eo) -> Option.may type_hint tho; expr_opt eo @@ -152,6 +154,9 @@ let find_in_syntax symbols (pack,decls) = | AbFrom th | AbTo th | AbOver th -> type_hint th | _ -> () ) d.d_flags; + | EStatic d -> + check KModuleType (fst d.d_name); + field_kind d.d_data ) decls let explore_uncached_modules tctx cs symbols = diff --git a/src/context/nativeLibraryHandler.ml b/src/context/nativeLibraryHandler.ml index 810413eb..db683720 100644 --- a/src/context/nativeLibraryHandler.ml +++ b/src/context/nativeLibraryHandler.ml @@ -24,8 +24,18 @@ let add_native_lib com file is_extern = match com.platform with | Globals.Flash -> SwfLoader.add_swf_lib com file is_extern | Globals.Java -> - let std = file = "lib/hxjava-std.jar" in - Java.add_java_lib com file std is_extern + let use_modern = Common.defined com Define.Jvm && not (Common.defined com Define.JarLegacyLoader) in + let add file = + let std = file = "lib/hxjava-std.jar" in + Java.add_java_lib com file std is_extern use_modern + in + if try Sys.is_directory file with Sys_error _ -> false then + let dir = file in + (fun _ -> Array.iter (fun file -> + if ExtString.String.ends_with file ".jar" then add (dir ^ "/" ^ file) () + ) (Sys.readdir file)) + else + add file | Globals.Cs -> let file, is_std = match ExtString.String.nsplit file "@" with | [file] -> diff --git a/src/context/sourcemaps.ml b/src/context/sourcemaps.ml index 985770b8..27966577 100644 --- a/src/context/sourcemaps.ml +++ b/src/context/sourcemaps.ml @@ -1,4 +1,4 @@ - +open Extlib_leftovers open Globals open Ast open Lexer diff --git a/src/context/typecore.ml b/src/context/typecore.ml index 8d99f788..7911346b 100644 --- a/src/context/typecore.ml +++ b/src/context/typecore.ml @@ -46,8 +46,8 @@ type macro_mode = type access_mode = | MGet - | MSet - | MCall + | MSet of Ast.expr option (* rhs, if exists *) + | MCall of Ast.expr list (* call arguments *) type typer_pass = | PBuildModule (* build the module structure and setup module type parameters *) @@ -133,22 +133,79 @@ and typer = { mutable opened : anon_status ref list; mutable vthis : tvar option; mutable in_call_args : bool; + mutable in_overload_call_args : bool; + mutable delayed_display : DisplayTypes.display_exception_kind option; + mutable monomorphs : monomorphs; (* events *) mutable on_error : typer -> string -> pos -> unit; memory_marker : float array; } + +and monomorphs = { + mutable perfunction : (tmono * pos) list; +} + +(* This record holds transient information about an (attempted) call on a field. It is created when resolving + field calls and is passed to overload filters. *) +type 'a field_call_candidate = { + (* The argument expressions for this call and whether or not the argument is optional on the + target function. *) + fc_args : texpr list; + (* The applied return type. *) + fc_ret : Type.t; + (* The applied function type. *) + fc_type : Type.t; + (* The class field being called. *) + fc_field : tclass_field; + (* The field monomorphs that were created for this call. *) + fc_monos : Type.t list; + (* The custom data associated with this call. *) + fc_data : 'a; +} + +type field_host = + | FHStatic of tclass + | FHInstance of tclass * tparams + | FHAbstract of tabstract * tparams * tclass + | FHAnon + +type field_access = { + (* The expression on which the field is accessed. For abstracts, this is a type expression + to the implementation class. *) + fa_on : texpr; + (* The field being accessed. *) + fa_field : tclass_field; + (* The host of the field. *) + fa_host : field_host; + (* Whether or not to inline the access. This can be set for non-inline fields via `inline call()` syntax. *) + fa_inline : bool; + (* The position of the field access expression in syntax. *) + fa_pos : pos; +} + +type static_extension_access = { + (* The `this` expression which should be passed as first argument. *) + se_this : texpr; + (* The field access information. *) + se_access : field_access; +} + exception Forbid_package of (string * path * pos) * pos list * string exception WithTypeError of error_msg * pos let memory_marker = [|Unix.time()|] +let locate_macro_error = ref true + let make_call_ref : (typer -> texpr -> texpr list -> t -> ?force_inline:bool -> pos -> texpr) ref = ref (fun _ _ _ _ ?force_inline:bool _ -> die "" __LOC__) let type_expr_ref : (?mode:access_mode -> typer -> expr -> WithType.t -> texpr) ref = ref (fun ?(mode=MGet) _ _ _ -> die "" __LOC__) let type_block_ref : (typer -> expr list -> WithType.t -> pos -> texpr) ref = ref (fun _ _ _ _ -> die "" __LOC__) let unify_min_ref : (typer -> texpr list -> t) ref = ref (fun _ _ -> die "" __LOC__) let unify_min_for_type_source_ref : (typer -> texpr list -> WithType.with_type_source option -> t) ref = ref (fun _ _ _ -> die "" __LOC__) let analyzer_run_on_expr_ref : (Common.context -> texpr -> texpr) ref = ref (fun _ _ -> die "" __LOC__) +let cast_or_unify_raise_ref : (typer -> ?uctx:unification_context option -> Type.t -> texpr -> pos -> texpr) ref = ref (fun _ ?uctx _ _ _ -> assert false) +let type_generic_function_ref : (typer -> field_access -> texpr list -> expr list -> WithType.t -> pos -> texpr) ref = ref (fun _ _ _ _ _ _ -> assert false) let pass_name = function | PBuildModule -> "build-module" @@ -170,6 +227,14 @@ let type_expr ?(mode=MGet) ctx e with_type = (!type_expr_ref) ~mode ctx e with_t let unify_min ctx el = (!unify_min_ref) ctx el let unify_min_for_type_source ctx el src = (!unify_min_for_type_source_ref) ctx el src +let spawn_monomorph' ctx p = + let mono = Monomorph.create () in + ctx.monomorphs.perfunction <- (mono,p) :: ctx.monomorphs.perfunction; + mono + +let spawn_monomorph ctx p = + TMono (spawn_monomorph' ctx p) + let make_static_this c p = let ta = mk_anon ~fields:c.cl_statics (ref (Statics c)) in mk (TTypeExpr (TClassDecl c)) ta p @@ -179,7 +244,7 @@ let make_static_field_access c cf t p = mk (TField (ethis,(FStatic (c,cf)))) t p let make_static_call ctx c cf map args t p = - let monos = List.map (fun _ -> mk_mono()) cf.cf_params in + let monos = List.map (fun _ -> spawn_monomorph ctx p) cf.cf_params in let map t = map (apply_params cf.cf_params monos t) in let ef = make_static_field_access c cf (map cf.cf_type) p in make_call ctx ef args (map t) p @@ -200,14 +265,16 @@ let unify ctx t1 t2 p = Unify_error l -> raise_or_display ctx l p -let unify_raise ctx t1 t2 p = +let unify_raise_custom uctx (ctx : typer) t1 t2 p = try - Type.unify t1 t2 + Type.unify_custom uctx t1 t2 with Unify_error l -> (* no untyped check *) raise (Error (Unify l,p)) +let unify_raise = unify_raise_custom default_unification_context + let save_locals ctx = let locals = ctx.locals in (fun() -> ctx.locals <- locals) @@ -220,7 +287,7 @@ let add_local ctx k n t p = (* ignore std lib *) if not (List.exists (ExtLib.String.starts_with p.pfile) ctx.com.std_path) then begin ctx.com.warning "This variable shadows a previously declared variable" p; - ctx.com.warning "Previous variable was here" v'.v_pos + ctx.com.warning (compl_msg "Previous variable was here") v'.v_pos end with Not_found -> () @@ -353,13 +420,14 @@ let exc_protect ?(force=true) ctx f (where:string) = let fake_modules = Hashtbl.create 0 let create_fake_module ctx file = - let key = Path.UniqueKey.create file in + let key = ctx.com.file_keys#get file in let file = Path.get_full_path file in let mdep = (try Hashtbl.find fake_modules key with Not_found -> let mdep = { m_id = alloc_mid(); m_path = (["$DEP"],file); m_types = []; + m_statics = None; m_extra = module_extra file (Define.get_signature ctx.com.defines) (file_time file) MFake []; } in Hashtbl.add fake_modules key mdep; @@ -377,21 +445,24 @@ let push_this ctx e = match e.eexpr with er,fun () -> ctx.this_stack <- List.tl ctx.this_stack let is_removable_field ctx f = - has_class_field_flag f CfExtern || Meta.has Meta.Generic f.cf_meta - || (match f.cf_kind with - | Var {v_read = AccRequire (s,_)} -> true - | Method MethMacro -> not ctx.in_macro - | _ -> false) + 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 ctx.in_macro + | _ -> false) + ) (** checks if we can access to a given class field using current context *) -let rec can_access ctx ?(in_overload=false) c cf stat = +let rec can_access ctx c cf stat = if (has_class_field_flag cf CfPublic) then true - else if not in_overload && ctx.com.config.pf_overload && Meta.has Meta.Overload cf.cf_meta then - true else if c == ctx.curclass then true - else + else match ctx.m.curmod.m_statics with + | Some c' when c == c' -> + true + | _ -> (* has metadata path *) let rec make_path c f = match c.cl_kind with | KAbstractImpl a -> fst a.a_path @ [snd a.a_path; f.cf_name] @@ -479,6 +550,10 @@ let rec can_access ctx ?(in_overload=false) c cf stat = | _ -> false) || (Meta.has Meta.PrivateAccess ctx.meta) +let check_field_access ctx c f stat p = + if not ctx.untyped && not (can_access ctx c f stat) then + display_error ctx ("Cannot access private field " ^ f.cf_name) p + (** removes the first argument of the class field's function type and all its overloads *) let prepare_using_field cf = match follow cf.cf_type with | TFun((_,_,tf) :: args,ret) -> @@ -511,6 +586,32 @@ let merge_core_doc ctx mt = end | _ -> ()) +let safe_mono_close ctx m p = + try + Monomorph.close m + with + Unify_error l -> + raise_or_display ctx l p + +let make_field_call_candidate args ret monos t cf data = { + fc_args = args; + fc_type = t; + fc_field = cf; + fc_data = data; + fc_ret = ret; + fc_monos = monos; +} + +let s_field_call_candidate fcc = + let pctx = print_context() in + let se = s_expr_pretty false "" false (s_type pctx) in + let sl_args = List.map se fcc.fc_args in + Printer.s_record_fields "" [ + "fc_args",String.concat ", " sl_args; + "fc_type",s_type pctx fcc.fc_type; + "fc_field",Printf.sprintf "%s: %s" fcc.fc_field.cf_name (s_type pctx fcc.fc_field.cf_type) + ] + (* -------------- debug functions to activate when debugging typer passes ------------------------------- *) (*/* diff --git a/src/core/abstract.ml b/src/core/abstract.ml index 5a0070d7..3bf96ac9 100644 --- a/src/core/abstract.ml +++ b/src/core/abstract.ml @@ -1,3 +1,5 @@ +open Globals +open Ast open Meta open TType open TFunctions @@ -9,50 +11,103 @@ let build_abstract a = match a.a_impl with | Some c -> ignore(c.cl_build()) | None -> () -let has_direct_to ab pl b = - List.exists (unify_to ab pl ~allow_transitive_cast:false b) ab.a_to +let find_cast_field uctx find = + let found = try + find {uctx with allow_transitive_cast = false} + with Not_found -> + find uctx + in + match found with + | Some value -> value + | None -> raise Not_found -let has_direct_from ab pl a b = - List.exists (unify_from ab pl a ~allow_transitive_cast:false b) ab.a_from +let find_field_from uctx a b ab tl = + List.find (unifies_from_field uctx a b ab tl) ab.a_from_field -let find_field_to ab pl b = - build_abstract ab; - List.find (unify_to_field ab pl b) ab.a_to_field +let find_field_to uctx a b ab tl = + List.find (unifies_to_field uctx a b ab tl) ab.a_to_field -let find_field_from ab pl a b = - build_abstract ab; - List.find (unify_from_field ab pl a b) ab.a_from_field +let find_to_from uctx a b a1 tl1 a2 tl2 = + build_abstract a1; + build_abstract a2; + find_cast_field uctx (fun uctx -> + if unifies_abstracts uctx a b a1 tl1 a2 tl2 then + None + else try + Some((a1,tl1,(find_field_to uctx a b a1 tl1))) + with Not_found -> + Some((a2,tl2,(find_field_from uctx a b a2 tl2))) + ) -let find_to_from f ab_left tl_left ab_right tl_right tleft tright = - build_abstract ab_left; - build_abstract ab_right; - if has_direct_to ab_right tl_right tleft || has_direct_from ab_left tl_left tright tleft then - raise Not_found +let find_from uctx a ab tl = + build_abstract ab; + if follow a == t_dynamic then + List.find (fun (t,_) -> follow t == t_dynamic) ab.a_from_field else - try f ab_right tl_right (fun () -> find_field_to ab_right tl_right tleft) - with Not_found -> f ab_left tl_left (fun () -> find_field_from ab_left tl_left tright tleft) + let b = TAbstract(ab,tl) in + find_cast_field uctx (fun uctx -> + if unifies_from uctx a b ab tl then + None + else + Some(find_field_from uctx a b ab tl) + ) -let find_to ab pl b = +let find_to uctx b ab tl = build_abstract ab; if follow b == t_dynamic then List.find (fun (t,_) -> follow t == t_dynamic) ab.a_to_field - else if has_direct_to ab pl b then - raise Not_found (* legacy compatibility *) else - find_field_to ab pl b - -let find_from ab pl a b = - build_abstract ab; - if follow a == t_dynamic then - List.find (fun (t,_) -> follow t == t_dynamic) ab.a_from_field - else if has_direct_from ab pl a b then - raise Not_found (* legacy compatibility *) - else - find_field_from ab pl a b + let a = TAbstract(ab,tl) in + find_cast_field uctx (fun uctx -> + if unifies_to uctx a b ab tl then + None + else + Some(find_field_to uctx a b ab tl) + ) let underlying_type_stack = new_rec_stack() -let rec get_underlying_type ?(return_first=false) a pl = +(** + Returns type parameters and the list of types, which should be known at compile time + to be able to choose multitype specialization. +*) +let rec find_multitype_params a pl = + match Meta.get Meta.MultiType a.a_meta with + | _,[],_ -> pl,pl + | _,el,_ -> + let relevant = Hashtbl.create 0 in + List.iter (fun e -> + let rec loop f e = match fst e with + | EConst(Ident s) -> + Hashtbl.replace relevant s f + | EMeta((Meta.Custom ":followWithAbstracts",_,_),e1) -> + loop follow_with_abstracts e1; + | _ -> + error "Type parameter expected" (pos e) + in + loop (fun t -> t) e + ) el; + let definitive_types = ref [] in + let tl = List.map2 (fun (n,_) t -> + try + let t = (Hashtbl.find relevant n) t in + definitive_types := t :: !definitive_types; + t + with Not_found -> + if not (has_mono t) then t + else t_dynamic + ) a.a_params pl in + tl,!definitive_types + +and find_multitype_specialization_type a pl = + let uctx = default_unification_context in + let m = mk_mono() in + let tl,definitive_types = find_multitype_params a pl in + ignore(find_to uctx m a tl); + if List.exists (fun t -> has_mono t) definitive_types then raise Not_found; + follow m + +and get_underlying_type ?(return_first=false) a pl = let maybe_recurse t = let rec loop t = match t with | TMono r -> @@ -85,29 +140,36 @@ let rec get_underlying_type ?(return_first=false) a pl = in try if not (Meta.has Meta.MultiType a.a_meta) then raise Not_found; - (* TODO: - Look into replacing `mk_mono` & `find_to` with `build_abstract a` & `TAbstract(a, pl)`. - `find_to` is probably needed for `@:multiType` - *) - let m = mk_mono() in - let _ = find_to a pl m in - maybe_recurse (follow m) + find_multitype_specialization_type a pl with Not_found -> if Meta.has Meta.CoreType a.a_meta then t_dynamic else maybe_recurse (apply_params a.a_params pl a.a_this) -let rec 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) -> follow_with_abstracts (get_underlying_type a tl) | t -> t +let rec follow_with_forward_ctor ?(build=false) t = match follow t with + | TAbstract(a,tl) as t -> + if build then build_abstract a; + if Meta.has Meta.ForwardNew a.a_meta && not (match a.a_impl with + | Some c -> PMap.mem "_new" c.cl_statics + | None -> false + ) then + follow_with_forward_ctor (get_underlying_type ~return_first:true a tl) + else + t + | t -> + t + let rec follow_with_abstracts_without_null t = match follow_without_null t with | TAbstract({a_path = [],"Null"},_) -> t | TAbstract(a,tl) when not (Meta.has Meta.CoreType a.a_meta) -> follow_with_abstracts_without_null (get_underlying_type a tl) | t -> - t \ No newline at end of file + t diff --git a/src/core/ast.ml b/src/core/ast.ml index 73885b78..c0db2756 100644 --- a/src/core/ast.ml +++ b/src/core/ast.ml @@ -16,7 +16,7 @@ along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. *) - +open Extlib_leftovers open Globals type keyword = @@ -98,6 +98,7 @@ type unop = | Not | Neg | NegBits + | Spread type string_literal_kind = | SDoubleQuotes @@ -135,6 +136,7 @@ type token = | Question | At | Dollar of string + | Spread type unop_flag = | Prefix @@ -205,7 +207,7 @@ and expr_def = | ECall of expr * expr list | ENew of placed_type_path * expr list | EUnop of unop * unop_flag * expr - | EVars of (placed_name * bool * type_hint option * expr option) list + | EVars of evar list | EFunction of function_kind * func | EBlock of expr list | EFor of expr * expr @@ -219,6 +221,7 @@ and expr_def = | EUntyped of expr | EThrow of expr | ECast of expr * type_hint option + | EIs of expr * type_hint | EDisplay of expr * display_kind | EDisplayNew of placed_type_path | ETernary of expr * expr * expr @@ -234,9 +237,44 @@ and type_param = { tp_meta : metadata; } +(** + This structure represents a documentation comment of a symbol. + + Use `Ast.get_doc_text` to generate a final user-readable text for a doc_block. +*) and doc_block = { + (** Contains own docs written nearby the symbol in Haxe code *) doc_own: string option; - mutable doc_inherited: (unit -> (string option)) list + (** + This field is for docs pointed by @:inheritDoc meta. + + It's populated with `InheritDoc.build_*` functions. + Each string in this list is compiled of a doc a single @:inheritDoc points to. + + E.g. calling `InheritDoc.build_class_field_doc` for `field4` (from sample below) + will produce `doc_inherited = ["Own field3 doc"; "Own field2 doc\nOwn field1 doc"]`. + + Sample: + ``` + class MyClass { + + /** Own field1 doc */ + function field1(); + + /** Own field2 doc */ + @:inheritDoc(MyClass.field1) function field2(); + + /** Own field3 doc */ + function field2(); + + /** Own field4 doc */ + @:inheritDoc(MyClass.field3) + @:inheritDoc(MyClass.field2) + function field4(); + } + ``` + *) + mutable doc_inherited: string list; } and documentation = doc_block option @@ -254,6 +292,8 @@ and access = | AMacro | AFinal | AExtern + | AAbstract + | AOverload and placed_access = access * pos @@ -271,6 +311,17 @@ and class_field = { mutable cff_kind : class_field_kind; } +and evar = { + ev_name : placed_name; + ev_final : bool; + ev_type : type_hint option; + ev_expr : expr option; + ev_meta : metadata; +} + +(* TODO: should we introduce CTMono instead? *) +let ct_mono = CTPath { tpackage = ["$"]; tname = "_hx_mono"; tparams = []; tsub = None } + type enum_flag = | EPrivate | EExtern @@ -282,6 +333,7 @@ type class_flag = | HExtends of placed_type_path | HImplements of placed_type_path | HFinal + | HAbstract type abstract_flag = | AbPrivate @@ -289,6 +341,7 @@ type abstract_flag = | AbTo of type_hint | AbOver of type_hint | AbExtern + | AbEnum type enum_constructor = { ec_name : placed_name; @@ -321,6 +374,7 @@ type type_def = | EEnum of (enum_flag, enum_constructor list) definition | ETypedef of (enum_flag, type_hint) definition | EAbstract of (abstract_flag, class_field list) definition + | EStatic of (placed_access, class_field_kind) definition | EImport of import | EUsing of placed_name list @@ -333,6 +387,15 @@ let mk_type_path ?(params=[]) ?sub (pack,name) = raise (Invalid_argument "Empty module name is not allowed"); { tpackage = pack; tname = name; tsub = sub; tparams = params; } +let mk_evar ?(final=false) ?(t:type_hint option) ?eo ?(meta=[]) name = + { + ev_name = name; + ev_final = final; + ev_type = t; + ev_expr = eo; + ev_meta = meta; + } + let is_lower_ident i = if String.length i = 0 then raise (Invalid_argument "Identifier name must not be empty") @@ -351,9 +414,16 @@ let doc_from_string s = Some { doc_own = Some s; doc_inherited = []; } let doc_from_string_opt = Option.map (fun s -> { doc_own = Some s; doc_inherited = []; }) +(** + Generates full doc block text out of `doc_block` structure + by concatenating `d.doc_own` and all entries of `d.doc_inherited` with new lines + in between. +*) let gen_doc_text d = let docs = - match d.doc_own with Some s -> [s] | None -> [] + match d.doc_own with + | Some s -> s :: d.doc_inherited + | None -> d.doc_inherited in String.concat "\n" docs @@ -364,11 +434,7 @@ let get_own_doc_opt = Option.map_default (fun d -> d.doc_own) None let rec is_postfix (e,_) op = match op with | Increment | Decrement | Not -> true - | Neg | NegBits -> false - -let is_prefix = function - | Increment | Decrement -> true - | Not | Neg | NegBits -> true + | Neg | NegBits | Spread -> false let base_class_name = snd @@ -413,6 +479,8 @@ let s_access = function | AMacro -> "macro" | AFinal -> "final" | AExtern -> "extern" + | AAbstract -> "abstract" + | AOverload -> "overload" let s_placed_access (a,_) = s_access a @@ -495,6 +563,7 @@ let s_unop = function | Not -> "!" | Neg -> "-" | NegBits -> "~" + | Spread -> "..." let s_token = function | Eof -> "" @@ -520,6 +589,7 @@ let s_token = function | Question -> "?" | At -> "@" | Dollar v -> "$" ^ v + | Spread -> "..." exception Invalid_escape_sequence of char * int * (string option) @@ -665,10 +735,10 @@ let map_expr loop (e,p) = ENew (t,el) | EUnop (op,f,e) -> EUnop (op,f,loop e) | EVars vl -> - EVars (List.map (fun (n,b,t,eo) -> - let t = opt type_hint t in - let eo = opt loop eo in - n,b,t,eo + EVars (List.map (fun v -> + let t = opt type_hint v.ev_type in + let eo = opt loop v.ev_expr in + { v with ev_type = t; ev_expr = eo } ) vl) | EFunction (kind,f) -> EFunction (kind,func f) | EBlock el -> EBlock (List.map loop el) @@ -708,6 +778,10 @@ let map_expr loop (e,p) = let e = loop e in let t = opt type_hint t in ECast (e,t) + | EIs (e,t) -> + let e = loop e in + let t = type_hint t in + EIs (e,t) | EDisplay (e,f) -> EDisplay (loop e,f) | EDisplayNew t -> EDisplayNew (tpath t) | ETernary (e1,e2,e3) -> @@ -729,7 +803,7 @@ let iter_expr loop (e,p) = match e with | EConst _ | EContinue | EBreak | EDisplayNew _ | EReturn None -> () | EParenthesis e1 | EField(e1,_) | EUnop(_,_,e1) | EReturn(Some e1) | EThrow e1 | EMeta(_,e1) - | ECheckType(e1,_) | EDisplay(e1,_) | ECast(e1,_) | EUntyped e1 -> loop e1; + | ECheckType(e1,_) | EDisplay(e1,_) | ECast(e1,_) | EIs(e1,_) | EUntyped e1 -> loop e1; | EArray(e1,e2) | EBinop(_,e1,e2) | EFor(e1,e2) | EWhile(e1,e2,_) | EIf(e1,e2,None) -> loop e1; loop e2; | ETernary(e1,e2,e3) | EIf(e1,e2,Some e3) -> loop e1; loop e2; loop e3; | EArrayDecl el | ENew(_,el) | EBlock el -> List.iter loop el @@ -749,7 +823,7 @@ let iter_expr loop (e,p) = | EFunction(_,f) -> List.iter (fun (_,_,_,_,eo) -> opt eo) f.f_args; opt f.f_expr - | EVars vl -> List.iter (fun (_,_,_,eo) -> opt eo) vl + | EVars vl -> List.iter (fun v -> opt v.ev_expr) vl let s_object_key_name name = function | DoubleQuotes -> "\"" ^ StringHelper.s_escape name ^ "\"" @@ -798,6 +872,7 @@ module Printer = struct | EThrow e -> "throw " ^ s_expr_inner tabs e | ECast (e,Some (t,_)) -> "cast (" ^ s_expr_inner tabs e ^ ", " ^ s_complex_type tabs t ^ ")" | ECast (e,None) -> "cast " ^ s_expr_inner tabs e + | EIs (e,(t,_)) -> s_expr_inner tabs e ^ " is " ^ s_complex_type tabs t | ETernary (e1,e2,e3) -> s_expr_inner tabs e1 ^ " ? " ^ s_expr_inner tabs e2 ^ " : " ^ s_expr_inner tabs e3 | ECheckType (e,(t,_)) -> "(" ^ s_expr_inner tabs e ^ " : " ^ s_complex_type tabs t ^ ")" | EMeta (m,e) -> s_metadata tabs m ^ " " ^ s_expr_inner tabs e @@ -884,8 +959,10 @@ module Printer = struct if List.length tl > 0 then "<" ^ String.concat ", " (List.map (s_type_param tabs) tl) ^ ">" else "" and s_func_arg tabs ((n,_),o,_,t,e) = if o then "?" else "" ^ n ^ s_opt_type_hint tabs t ":" ^ s_opt_expr tabs e " = " - and s_var tabs ((n,_),_,t,e) = - n ^ (s_opt_type_hint tabs t ":") ^ s_opt_expr tabs e " = " + and s_var tabs v = + let s = (fst v.ev_name) ^ (s_opt_type_hint tabs v.ev_type ":") ^ s_opt_expr tabs v.ev_expr " = " in + if v.ev_meta = [] then s + else (String.concat " " (List.map (s_metadata tabs) v.ev_meta)) ^ " " ^ s and s_case tabs (el,e1,e2,_) = "case " ^ s_expr_list tabs el ", " ^ (match e1 with None -> ":" | Some e -> " if (" ^ s_expr_inner tabs e ^ "):") ^ @@ -1031,9 +1108,14 @@ module Expr = struct loop e1 | EVars vl -> add "EVars"; - List.iter (fun ((n,p),_,cto,eo) -> - add (Printf.sprintf "%s %s%s" tabs n (match cto with None -> "" | Some (ct,_) -> ":" ^ Printer.s_complex_type "" ct)); - match eo with + List.iter (fun v -> + let t_hint = + match v.ev_type with + | None -> "" + | Some (ct,_) -> ":" ^ Printer.s_complex_type "" ct + in + add (Printf.sprintf "%s %s%s" tabs (fst v.ev_name) t_hint); + match v.ev_expr with | None -> () | Some e -> loop' (Printf.sprintf "%s " tabs) e @@ -1087,6 +1169,9 @@ module Expr = struct | ECast(e1,_) -> add "ECast"; loop e1; + | EIs(e1,_) -> + add "EIs"; + loop e1; | EDisplay(e1,dk) -> add ("EDisplay " ^ (s_display_kind dk)); loop e1 @@ -1106,6 +1191,20 @@ module Expr = struct in loop' "" e; Buffer.contents buf + + let find_ident e = + let rec loop e = match fst e with + | EConst ct -> + begin match ct with + | Ident s -> + Some s + | _ -> + None + end + | _ -> + None + in + loop e end let has_meta_option metas meta s = diff --git a/src/core/display/completionItem.ml b/src/core/display/completionItem.ml index 94f7331b..26c1dc15 100644 --- a/src/core/display/completionItem.ml +++ b/src/core/display/completionItem.ml @@ -20,6 +20,7 @@ module CompletionModuleKind = struct | TypeAlias | Struct | TypeParameter + | Static let to_int = function | Class -> 0 @@ -30,6 +31,7 @@ module CompletionModuleKind = struct | TypeAlias -> 5 | Struct -> 6 | TypeParameter -> 7 + | Static -> 8 end module ImportStatus = struct @@ -68,6 +70,7 @@ module CompletionModuleType = struct doc : documentation; is_extern : bool; is_final : bool; + is_abstract : bool; kind : CompletionModuleKind.t; has_constructor : not_bool; source : module_type_source; @@ -95,6 +98,7 @@ module CompletionModuleType = struct doc = d.d_doc; is_extern = List.mem HExtern d.d_flags; is_final = List.mem HFinal d.d_flags; + is_abstract = List.mem HAbstract d.d_flags; kind = if List.mem HInterface d.d_flags then Interface else Class; has_constructor = ctor; source = Syntax td; @@ -110,6 +114,7 @@ module CompletionModuleType = struct doc = d.d_doc; is_extern = List.mem EExtern d.d_flags; is_final = false; + is_abstract = false; kind = Enum; has_constructor = No; source = Syntax td; @@ -127,6 +132,7 @@ module CompletionModuleType = struct doc = d.d_doc; is_extern = List.mem EExtern d.d_flags; is_final = false; + is_abstract = false; kind = kind; has_constructor = if kind = Struct then No else Maybe; source = Syntax td; @@ -150,10 +156,28 @@ module CompletionModuleType = struct doc = d.d_doc; is_extern = List.mem AbExtern d.d_flags; is_final = false; - kind = if Meta.has Meta.Enum d.d_meta then EnumAbstract else Abstract; + is_abstract = false; + kind = if List.mem AbEnum d.d_flags then EnumAbstract else Abstract; has_constructor = ctor; source = Syntax td; } + | EStatic d -> + { + pack = pack; + name = fst d.d_name; + module_name = module_name; + pos = p; + is_private = List.exists (fun (f,_) -> f = APrivate) d.d_flags; + params = d.d_params; + meta = d.d_meta; + doc = d.d_doc; + is_extern = List.exists (fun (f,_) -> f = AExtern) d.d_flags; + is_final = true; + is_abstract = false; + kind = Static; + has_constructor = No; + source = Syntax td; + } | EImport _ | EUsing _ -> raise Exit @@ -163,33 +187,41 @@ module CompletionModuleType = struct | Some c -> try let cf = PMap.find "_new" c.cl_statics in - if c.cl_extern || (has_class_field_flag cf CfPublic) then Yes else YesButPrivate + if (has_class_flag c CExtern) || (has_class_field_flag cf CfPublic) then Yes else YesButPrivate with Not_found -> No in let ctor c = try - let _,cf = get_constructor (fun cf -> cf.cf_type) c in - if c.cl_extern || (has_class_field_flag cf CfPublic) then Yes else YesButPrivate + if has_class_flag c CAbstract then raise Not_found; + let cf = get_constructor c in + if (has_class_flag c CExtern) || (has_class_field_flag cf CfPublic) then Yes else YesButPrivate with Not_found -> No in - let is_extern,is_final,kind,ctor = match mt with + let rec ctor_info = function | TClassDecl c -> - c.cl_extern,c.cl_final,(if c.cl_interface then Interface else Class),ctor c + (has_class_flag c CExtern),has_class_flag c CFinal,has_class_flag c CAbstract,(if (has_class_flag c CInterface) then Interface else Class),ctor c | TEnumDecl en -> - en.e_extern,false,Enum,No + en.e_extern,false,false,Enum,No | TTypeDecl td -> let kind,ctor = match follow td.t_type with | TAnon _ -> Struct,No | TInst(c,_) -> TypeAlias,ctor c - | TAbstract(a,_) -> TypeAlias,actor a + | TAbstract(a,_) -> let _,_,_,_,ctor = ctor_info (TAbstractDecl a) in TypeAlias,ctor | _ -> TypeAlias,No in - false,false,kind,ctor + false,false,false,kind,ctor | TAbstractDecl a -> - false,false,(if Meta.has Meta.Enum a.a_meta then EnumAbstract else Abstract),actor a + let kind = if a.a_enum then EnumAbstract else Abstract in + let is_extern,is_final,is_abstract,ctor = match Abstract.follow_with_forward_ctor (TAbstract(a,List.map snd a.a_params)) with + | TInst(c,_) -> let is_extern,is_final,is_abstract,_,ctor = ctor_info (TClassDecl c) in is_extern,is_final,is_abstract,ctor + | TAbstract(a,_) -> false,false,false,actor a + | _ -> false,false,false,No + in + is_extern,is_final,is_abstract,kind,ctor in + let is_extern,is_final,is_abstract,kind,ctor = ctor_info mt in let infos = t_infos mt in let convert_type_param (s,t) = match follow t with | TInst(c,_) -> { @@ -212,6 +244,7 @@ module CompletionModuleType = struct doc = infos.mt_doc; is_extern = is_extern; is_final = is_final; + is_abstract = is_abstract; kind = kind; has_constructor = ctor; source = Typed mt; @@ -235,6 +268,7 @@ module CompletionModuleType = struct ("params",jlist (generate_ast_type_param ctx) cm.params) :: ("isExtern",jbool cm.is_extern) :: ("isFinal",jbool cm.is_final) :: + ("isAbstract",jbool cm.is_abstract) :: (if ctx.generation_mode = GMFull then ["doc",jopt jstring (gen_doc_text_opt cm.doc)] else []) | GMMinimum -> match generate_minimum_metadata ctx cm.meta with diff --git a/src/core/display/displayPosition.ml b/src/core/display/displayPosition.ml index db9a055a..a831d727 100644 --- a/src/core/display/displayPosition.ml +++ b/src/core/display/displayPosition.ml @@ -50,12 +50,11 @@ class display_position_container = method enclosed_in p = encloses_position pos p (** - Check if `file` contains current display position + Check if a file with `file_key` contains current display position *) - method is_in_file file = - file <> "?" - && pos.pfile <> "?" - && self#get_file_key = Path.UniqueKey.create file + method is_in_file file_key = + pos.pfile <> "?" + && self#get_file_key = file_key (** Cut `p` at the position of the latest `display_position#set pos` call. *) diff --git a/src/core/display/javadoc.ml b/src/core/display/javadoc.ml new file mode 100644 index 00000000..7744e192 --- /dev/null +++ b/src/core/display/javadoc.ml @@ -0,0 +1,148 @@ +type doc_tag = + | Returns of string + | Deprecated of string + | Since of string + | Default of string + | See of string + | Param of string * string + | Throws of string * string + | Event of string * string + | Custom of string * string + +let string_of_tag = function + | Returns s -> "returns " ^ s + | Deprecated s -> "deprecated " ^ s + | Since s -> "since " ^ s + | Default s -> "default " ^ s + | See s -> "see " ^ s + | Param(s1,s2) -> "param " ^ s1 ^ " " ^ s2 + | Throws(s1,s2) -> "throws " ^ s1 ^ " " ^ s2 + | Event(s1,s2) -> "event " ^ s1 ^ " " ^ s2 + | Custom(s1,s2) -> s1 ^ " " ^ s2 + +class javadoc (doc : string) = object(self) + + val mutable actual_doc = doc; + val mutable tags = [] + val mutable parsed_tags = false + + method get_param_info (name : string) = + if not parsed_tags then self#parse_tags; + let rec loop tags = match tags with + | (Param(name',value)) :: _ when name = name' -> + Some value + | _ :: tags -> + loop tags + | [] -> + None + in + loop tags + + method parse_tags = + parsed_tags <- true; + let l = String.length doc in + let commit_tag name value = + let separate () = + try + ExtString.String.split value " " + with _ -> + value,"" + in + let add tag = tags <- tag :: tags in + match name with + | "param" -> + let name,doc = separate() in + add (Param(name,doc)) + | "exception" | "throws" -> + let name,doc = separate() in + add (Throws(name,doc)) + | "event" -> + let name,doc = separate() in + add (Event(name,doc)) + | "deprecated" -> + add (Deprecated value) + | "return" | "returns" -> + add (Returns value) + | "since" -> + add (Since value) + | "default" -> + add (Default value) + | "see" -> + add (See value) + | _ -> + add (Custom(name,value)) + in + let read_until p c = + let pn = String.index_from doc p c in + String.sub doc p (pn - p),pn + 1 + in + (* Returns the first non-whitespace character while counting indentation. *) + let rec newline had_star indent p = + if p >= l then + None + else begin + let c = doc.[p] in + match c with + | ' ' | '\t' -> + newline had_star (indent + 1) (p + 1) + | '*' when not had_star -> + newline true 0 (p + 1) + | '\r' | '\n' -> + newline false 0 (p + 1) + | _ -> + Some(c,p + 1,indent) + end + in + let newline p = newline false 0 p in + (* Returns (position of last real char, position of next char) *) + let last_char_pos_on_line p = + let rec loop pl pn = + if pn = l then + pl,pn + else match doc.[pn] with + | ' ' | '\r' | '\t' -> + loop pl (pn + 1) + | '\n' -> + pl,pn + 1 + | _ -> + loop pn (pn + 1) + in + loop p p + in + let doc_buf = Buffer.create 0 in + let rec loop p = match newline p with + | None -> + () + | Some(c,p,indent) -> + match c with + | '@' -> + begin try + let name,pn = read_until p ' ' in + let value_buf = Buffer.create 0 in + (* Append lines that have higher indentation. *) + let rec loop_value ps = + let pl,pn = last_char_pos_on_line ps in + Buffer.add_substring value_buf doc ps (pl - ps + 1); + match newline pn with + | Some(c,p,indent') when indent' > indent -> + Buffer.add_char value_buf '\n'; + Buffer.add_char value_buf c; + loop_value p + | _ -> + pn + in + let pn = loop_value pn in + commit_tag name (Buffer.contents value_buf); + loop pn + with Not_found -> + Buffer.add_substring doc_buf doc p (l - p) + end + | _ -> + Buffer.add_char doc_buf c; + let pl,pn = last_char_pos_on_line p in + Buffer.add_substring doc_buf doc p (pl - p + 1); + loop pn + in + loop 0; + tags <- List.rev tags; +end \ No newline at end of file diff --git a/src/core/displayTypes.ml b/src/core/displayTypes.ml index 5b840fd1..737cb166 100644 --- a/src/core/displayTypes.ml +++ b/src/core/displayTypes.ml @@ -23,6 +23,7 @@ module SymbolKind = struct | Operator | EnumMember | Constant + | Module let to_int = function | Class -> 1 @@ -41,6 +42,7 @@ module SymbolKind = struct | Operator -> 14 | EnumMember -> 15 | Constant -> 16 + | Module -> 17 end module SymbolInformation = struct @@ -84,6 +86,7 @@ module DiagnosticsKind = struct | DKParserError | DKDeprecationWarning | DKInactiveBlock + | DKMissingFields let to_int = function | DKUnusedImport -> 0 @@ -93,13 +96,20 @@ module DiagnosticsKind = struct | DKParserError -> 4 | DKDeprecationWarning -> 5 | DKInactiveBlock -> 6 + | DKMissingFields -> 7 end module CompletionResultKind = struct + type expected_type_completion = { + expected_type : CompletionItem.CompletionType.t; + expected_type_followed : CompletionItem.CompletionType.t; + compatible_types : CompletionItem.CompletionType.t list; + } + type t = | CRField of CompletionItem.t * pos * Type.t option * (Type.t * Type.t) option | CRStructureField - | CRToplevel of (CompletionItem.CompletionType.t * CompletionItem.CompletionType.t) option + | CRToplevel of expected_type_completion option | CRMetadata | CRTypeHint | CRExtends @@ -108,7 +118,7 @@ module CompletionResultKind = struct | CRImport | CRUsing | CRNew - | CRPattern of (CompletionItem.CompletionType.t * CompletionItem.CompletionType.t) option * bool + | CRPattern of expected_type_completion option * bool | CROverride | CRTypeRelation | CRTypeDecl @@ -116,9 +126,10 @@ module CompletionResultKind = struct let to_json ctx kind = let expected_type_fields t = match t with | None -> [] - | Some(ct1,ct2) -> [ - "expectedType",CompletionItem.CompletionType.to_json ctx ct1; - "expectedTypeFollowed",CompletionItem.CompletionType.to_json ctx ct2; + | Some ext -> [ + "expectedType",CompletionItem.CompletionType.to_json ctx ext.expected_type; + "expectedTypeFollowed",CompletionItem.CompletionType.to_json ctx ext.expected_type_followed; + "compatibleTypes",jarray (List.map (CompletionItem.CompletionType.to_json ctx) ext.compatible_types); ] in let i,args = match kind with @@ -339,4 +350,59 @@ let string_of_symbol = function | SKField (cf,_) | SKConstructor cf -> cf.cf_name | SKEnumField ef -> ef.ef_name | SKVariable v -> v.v_name - | SKOther -> "" \ No newline at end of file + | SKOther -> "" + +type hover_result = { + hitem : CompletionItem.t; + hpos : pos; + hexpected : WithType.t option; +} + +type fields_result = { + fitems : CompletionItem.t list; + fkind : CompletionResultKind.t; + fsubject : completion_subject; +} + +type signature_kind = + | SKCall + | SKArrayAccess + +(* diagnostics *) + +type missing_field_cause = + | AbstractParent of tclass * tparams + | ImplementedInterface of tclass * tparams + | PropertyAccessor of tclass_field * bool (* true = getter *) + | FieldAccess + | FinalFields of tclass_field list + +and missing_fields_diagnostics = { + mf_pos : pos; + mf_on : module_type; + mf_fields : (tclass_field * Type.t * CompletionItem.CompletionType.t) list; + mf_cause : missing_field_cause; +} + +and module_diagnostics = + | MissingFields of missing_fields_diagnostics + +type diagnostics_context = { + mutable removable_code : (string * pos * pos) list; + mutable import_positions : (pos,bool ref) PMap.t; + mutable dead_blocks : (Path.UniqueKey.t,(pos * expr) list) Hashtbl.t; + mutable unresolved_identifiers : (string * pos * (string * CompletionItem.t * int) list) list; + mutable diagnostics_messages : (string * pos * DiagnosticsKind.t * DiagnosticsSeverity.t) list; + mutable missing_fields : (pos,(module_type * (missing_fields_diagnostics list ref))) PMap.t; +} + +type display_exception_kind = + | DisplayDiagnostics of diagnostics_context + | Statistics of string + | ModuleSymbols of string + | Metadata of string + | DisplaySignatures of (((tsignature * CompletionItem.CompletionType.ct_function) * documentation) list * int * int * signature_kind) option + | DisplayHover of hover_result option + | DisplayPositions of pos list + | DisplayFields of fields_result option + | DisplayPackage of string list \ No newline at end of file diff --git a/src/core/error.ml b/src/core/error.ml index 795035d7..2550979e 100644 --- a/src/core/error.ml +++ b/src/core/error.ml @@ -20,6 +20,7 @@ and error_msg = | Stack of error_msg * error_msg | Call_error of call_error | No_constructor of module_type + | Abstract_class of module_type and type_not_found_reason = | Private_type @@ -38,6 +39,11 @@ let short_type ctx t = let tstr = s_type ctx t in if String.length tstr > 150 then String.sub tstr 0 147 ^ "..." else tstr +(** + Should be called for each complementary error message. +*) +let compl_msg s = "... " ^ s + let unify_error_msg ctx err = match err with | Cannot_unify (t1,t2) -> s_type ctx t1 ^ " should be " ^ s_type ctx t2 @@ -160,7 +166,7 @@ module BetterErrors = struct | TAbstract (a,tl) -> s_type_path a.a_path ^ s_type_params ctx tl | TFun ([],_) -> - "Void -> ..." + "() -> ..." | TFun (l,t) -> let args = match l with | [] -> "()" @@ -180,7 +186,7 @@ module BetterErrors = struct | AbstractStatics a -> Printf.sprintf "{ AbstractStatics %s }" (s_type_path a.a_path) | _ -> let fl = PMap.fold (fun f acc -> ((if Meta.has Meta.Optional f.cf_meta then " ?" else " ") ^ f.cf_name) :: acc) a.a_fields [] in - "{" ^ (if not (is_closed a) then "+" else "") ^ String.concat "," fl ^ " }" + "{" ^ String.concat "," fl ^ " }" end | TDynamic t2 -> "Dynamic" ^ s_type_params ctx (if t == t2 then [] else [t2]) @@ -259,7 +265,7 @@ module BetterErrors = struct String.concat "\n" (List.rev_map (unify_error_msg ctx) access.acc_messages) | Some access_next -> let slhs,srhs = loop access_next access in - Printf.sprintf "error: %s\n have: %s\n want: %s" (Buffer.contents message_buffer) slhs srhs + Printf.sprintf "error: %s\nhave: %s\nwant: %s" (Buffer.contents message_buffer) slhs srhs end let rec error_msg = function @@ -272,6 +278,7 @@ let rec error_msg = function | Stack (m1,m2) -> error_msg m1 ^ "\n" ^ error_msg m2 | Call_error err -> s_call_error err | No_constructor mt -> (s_type_path (t_infos mt).mt_path ^ " does not have a constructor") + | Abstract_class mt -> (s_type_path (t_infos mt).mt_path) ^ " is abstract and cannot be constructed" and s_call_error = function | Not_enough_arguments tl -> diff --git a/src/core/globals.ml b/src/core/globals.ml index 5386138a..6a0f0949 100644 --- a/src/core/globals.ml +++ b/src/core/globals.ml @@ -24,7 +24,7 @@ type platform = | Hl | Eval -let version = 4105 +let version = 4200 let version_major = version / 1000 let version_minor = (version mod 1000) / 100 let version_revision = (version mod 100) diff --git a/src/core/inheritDoc.ml b/src/core/inheritDoc.ml new file mode 100644 index 00000000..66a26463 --- /dev/null +++ b/src/core/inheritDoc.ml @@ -0,0 +1,231 @@ +open Globals +open Ast +open Type +open Typecore + +let expr_to_target e = + let rec loop (e,p) = + match e with + | EConst (Ident s) when s <> "" -> [s] + | EField (e,s) -> s :: loop e + | _ -> Error.error "Invalid target expression for @:inheritDoc" p + in + match loop e with + | sub_name :: type_name :: pack when not (is_lower_ident type_name) -> + (List.rev pack, type_name), Some sub_name + | type_name :: pack -> + (List.rev pack, type_name), None + | [] -> + Error.error "Invalid target path for @:inheritDoc" (snd e) + +let rec get_constructor c = + match c.cl_constructor, c.cl_super with + | Some ctor, _ -> Some c, ctor + | None, None -> raise Not_found + | None, Some (csup,_) -> get_constructor csup + +let rec get_class_field c field_name = + try + let cf = + try PMap.find field_name c.cl_fields + with Not_found -> PMap.find field_name c.cl_statics + in + Some c, cf + with Not_found -> + match c.cl_super with + | None -> raise Not_found + | Some (csup, _) -> get_class_field csup field_name + +let find_type ctx tp allow_no_params = + try Typeload.load_instance' ctx tp allow_no_params + with _ -> raise Not_found + +(** + Finds `@:inheritDoc` meta in `meta` and populates `doc_inherited` field of `doc` + with found docs. +*) +let rec build_doc ctx ?no_args_cb doc meta = + let add d = + match d with + | None -> () + | Some d -> + match gen_doc_text d with + | "" -> () + | s -> + match !doc with + | None -> doc := Some { doc_own = None; doc_inherited = [s]; } + | Some doc -> doc.doc_inherited <- s :: doc.doc_inherited + in + List.iter (fun m -> + match m with + | (Meta.InheritDoc,[],_) -> + (match no_args_cb with + | Some fn -> fn add + | None -> ()) + | (Meta.InheritDoc,targets,_) -> + List.iter (fun t -> add (get_target_doc ctx t)) targets + | _ -> () + ) meta + +(** + Populates `doc_inherited` field of `c.cl_doc` +*) +and build_class_doc ctx c = + (match c.cl_doc with + | None | Some { doc_inherited = [] } -> () + | Some d -> d.doc_inherited <- [] + ); + let doc = ref c.cl_doc in + let no_args_cb add = + match c.cl_super with + | None -> () + | Some (csup,_) -> + build_class_doc ctx csup; + add csup.cl_doc + in + build_doc ctx ~no_args_cb doc c.cl_meta; + c.cl_doc <- !doc + +(** + Populates `doc_inherited` field of `enm.e_doc` +*) +and build_enum_doc ctx enm = + (match enm.e_doc with + | None | Some { doc_inherited = [] } -> () + | Some d -> d.doc_inherited <- [] + ); + let doc = ref enm.e_doc in + build_doc ctx doc enm.e_meta; + enm.e_doc <- !doc + +(** + Populates `doc_inherited` field of `a.a_doc` +*) +and build_abstract_doc ctx a = + (match a.a_doc with + | None | Some { doc_inherited = [] } -> () + | Some d -> d.doc_inherited <- [] + ); + let doc = ref a.a_doc in + build_doc ctx doc a.a_meta; + a.a_doc <- !doc + +(** + Populates `doc_inherited` field of `cf.cf_doc` +*) +and build_class_field_doc ctx c_opt cf = + (match cf.cf_doc with + | None | Some { doc_inherited = [] } -> () + | Some d -> d.doc_inherited <- [] + ); + let doc = ref cf.cf_doc in + let no_args_cb add = + match c_opt with + | Some { cl_super = Some (csup,_) } -> + (try + let c_opt, cf_sup = + if cf.cf_name = "new" then get_constructor csup + else get_class_field csup cf.cf_name + in + build_class_field_doc ctx c_opt cf_sup; + add cf_sup.cf_doc + with Not_found -> ()) + | _ -> () + in + build_doc ctx ~no_args_cb doc cf.cf_meta; + cf.cf_doc <- !doc + +(** + Populates `doc_inherited` field of `ef.ef_doc` +*) +and build_enum_field_doc ctx ef = + (match ef.ef_doc with + | None | Some { doc_inherited = [] } -> () + | Some d -> d.doc_inherited <- [] + ); + let doc = ref ef.ef_doc in + build_doc ctx doc ef.ef_meta; + ef.ef_doc <- !doc + +(** + Collects `Ast.documentation` for a provided `target` + The `target` is an AST expr representing a dot path for a type or a field. + E.g. `my.pack.MyType` or `my.pack.MyType.field` +*) +and get_target_doc ctx e_target = + let path,sub = expr_to_target e_target in + let resolve_field field_name = + let tp = + match List.rev (fst path) with + | module_name :: pack_rev when not (is_lower_ident module_name) -> + mk_type_path ~sub:(snd path) (List.rev pack_rev,module_name) + | _ -> + mk_type_path path + in + let t = (find_type ctx (tp,snd e_target) true) in + try + match follow t with + | TInst (c, _) -> + let c_opt, cf = + if field_name = "new" then get_constructor c + else get_class_field c field_name + in + build_class_field_doc ctx c_opt cf; + cf.cf_doc + | TAnon a -> + let cf = PMap.find field_name a.a_fields in + build_class_field_doc ctx None cf; + cf.cf_doc + | TEnum (enm, _) -> + let ef = PMap.find field_name enm.e_constrs in + build_enum_field_doc ctx ef; + ef.ef_doc + | TAbstract ({ a_impl = Some c }, _) -> + let c_opt, cf = + let field_name = + if field_name = "new" then "_new" + else field_name + in + get_class_field c field_name + in + build_class_field_doc ctx c_opt cf; + cf.cf_doc + | _ -> raise Not_found + with Not_found -> + None + in + let rec resolve_type_t t = + match follow t with + | TInst (c, _) -> + build_class_doc ctx c; + c.cl_doc + | TAbstract (a, _) -> + build_abstract_doc ctx a; + a.a_doc + | TEnum (enm, _) -> + build_enum_doc ctx enm; + enm.e_doc + | _ -> raise Not_found + in + let resolve_type () = + let tp = mk_type_path path, snd e_target in + resolve_type_t (find_type ctx tp true) + in + let resolve_sub_type sub = + let tp = mk_type_path ~sub path, snd e_target in + resolve_type_t (find_type ctx tp true) + in + try + match sub with + (* type *) + | None -> + resolve_type() + (* field or sub type *) + | Some s -> + if is_lower_ident s then + resolve_field s + else + (try resolve_sub_type s + with Not_found -> resolve_field s) + with Not_found -> + None diff --git a/src/core/json/genjson.ml b/src/core/json/genjson.ml index eeb15062..e41b9351 100644 --- a/src/core/json/genjson.ml +++ b/src/core/json/genjson.ml @@ -38,11 +38,18 @@ let generate_module_path' mpath = let generate_module_path mpath = jobject (generate_module_path' mpath) -let generate_type_path' mpath tpath = +let generate_type_path' mpath tpath meta = ("typeName",jstring (snd tpath)) :: generate_module_path' mpath -let generate_type_path mpath tpath = jobject (generate_type_path' mpath tpath) +let generate_type_path mpath tpath meta = + let rec loop = function + | [] -> tpath + | (Meta.RealPath,[(Ast.EConst (Ast.String(s,_)),_)],_) :: _ -> parse_path s + | _ :: l -> loop l + in + let tpath = loop meta in + jobject (generate_type_path' mpath tpath meta) let generate_adt ctx tpath name args = let field = ("kind",jstring name) in @@ -52,13 +59,26 @@ let generate_adt ctx tpath name args = in jobject fields -let class_ref ctx c = generate_type_path c.cl_module.m_path c.cl_path -let enum_ref ctx en = generate_type_path en.e_module.m_path en.e_path -let typedef_ref ctx td = generate_type_path td.t_module.m_path td.t_path -let abstract_ref ctx a = generate_type_path a.a_module.m_path a.a_path -let moduletype_ref ctx mt = generate_module_path (t_path mt) -let classfield_ref ctx cf = jstring cf.cf_name -let enumfield_ref ctx ef = jstring ef.ef_name +let field_name name meta = + try + begin match Meta.get Meta.RealPath meta with + | _,[EConst (String (s,_)),_],_ -> s + | _ -> raise Not_found + end; + with Not_found -> + name + +let class_ref ctx c = generate_type_path c.cl_module.m_path c.cl_path c.cl_meta +let enum_ref ctx en = generate_type_path en.e_module.m_path en.e_path en.e_meta +let typedef_ref ctx td = generate_type_path td.t_module.m_path td.t_path td.t_meta +let abstract_ref ctx a = generate_type_path a.a_module.m_path a.a_path a.a_meta + +let moduletype_ref ctx mt = + let infos = t_infos mt in + generate_type_path infos.mt_module.m_path infos.mt_path infos.mt_meta + +let classfield_ref ctx cf = jstring (field_name cf.cf_name cf.cf_meta) +let enumfield_ref ctx ef = jstring (field_name ef.ef_name ef.ef_meta) let local_ref ctx v = jint v.v_id let generate_pos ctx p = @@ -138,6 +158,7 @@ let generate_unop ctx op = | Not -> "OpNot" | Neg -> "OpNeg" | NegBits -> "OpNegBits" + | Spread -> "OpSpread" in jstring name @@ -149,7 +170,7 @@ let rec generate_expr ctx e = and generate_metadata_entry ctx (m,el,p) = jobject [ "name",jstring (Meta.to_string m); - "params",jlist (generate_expr ctx) el; + "args",jlist (generate_expr ctx) el; "pos",generate_pos ctx p; ] @@ -198,10 +219,10 @@ let rec generate_type ctx t = (* return_partial_type := false; *) loop t | TDynamic t -> "TDynamic",Some (if t == t_dynamic then jnull else generate_type ctx t) - | TInst(c,tl) -> "TInst",Some (generate_type_path_with_params ctx c.cl_module.m_path c.cl_path tl) - | TEnum(en,tl) -> "TEnum",Some (generate_type_path_with_params ctx en.e_module.m_path en.e_path tl) - | TType(td,tl) -> "TType",Some (generate_type_path_with_params ctx td.t_module.m_path td.t_path tl) - | TAbstract(a,tl) -> "TAbstract",Some (generate_type_path_with_params ctx a.a_module.m_path a.a_path tl) + | TInst(c,tl) -> "TInst",Some (generate_type_path_with_params ctx c.cl_module.m_path c.cl_path tl c.cl_meta) + | TEnum(en,tl) -> "TEnum",Some (generate_type_path_with_params ctx en.e_module.m_path en.e_path tl en.e_meta) + | TType(td,tl) -> "TType",Some (generate_type_path_with_params ctx td.t_module.m_path td.t_path tl td.t_meta) + | TAbstract(a,tl) -> "TAbstract",Some (generate_type_path_with_params ctx a.a_module.m_path a.a_path tl a.a_meta) | TAnon an -> "TAnonymous", Some(generate_anon ctx an) | TFun(tl,tr) -> "TFun", Some (jobject (generate_function_signature ctx tl tr)) in @@ -211,7 +232,6 @@ let rec generate_type ctx t = and generate_anon_status ctx status = let name,args = match status with | Closed -> "AClosed",None - | Opened -> "AOpened",None | Const -> "AConst",None | Extend tl -> "AExtend", Some (generate_types ctx tl) | Statics c -> "AClassStatics",Some (class_ref ctx c) @@ -246,9 +266,9 @@ and generate_function_signature ctx tl tr = and generate_types ctx tl = jlist (generate_type ctx) tl -and generate_type_path_with_params ctx mpath tpath tl = +and generate_type_path_with_params ctx mpath tpath tl meta = jobject [ - "path",generate_type_path mpath tpath; + "path",generate_type_path mpath tpath meta; "params",generate_types ctx tl; ] @@ -267,7 +287,9 @@ and generate_type_parameter ctx (s,t) = (* texpr *) and generate_tvar ctx v = - let generate_extra (params,eo) = jobject ( + let generate_extra ve = + let (params,eo) = (ve.v_params,ve.v_expr) in + jobject ( ("params",jlist (generate_type_parameter ctx) params) :: (match eo with | None -> [] @@ -279,12 +301,12 @@ and generate_tvar ctx v = "id",jint v.v_id; "name",jstring v.v_name; "type",generate_type ctx v.v_type; - "capture",jbool v.v_capture; + "capture",jbool (has_var_flag v VCaptured); "extra",jopt generate_extra v.v_extra; "meta",generate_metadata ctx v.v_meta; "pos",generate_pos ctx v.v_pos; - "isFinal",jbool v.v_final; - "isInline",jbool (match v.v_extra with Some (_,Some _) -> true | _ -> false); + "isFinal",jbool (has_var_flag v VFinal); + "isInline",jbool (match v.v_extra with Some {v_expr = Some _} -> true | _ -> false); ] in let origin_to_int = function | TVOLocalVariable -> 0 @@ -483,7 +505,6 @@ and generate_class_field' ctx cfs cf = | AccNo -> "AccNo",None | AccNever -> "AccNever",None | AccCtor -> "AccCtor",None - | AccResolve -> "AccResolve",None | AccCall -> "AccCall",None | AccInline -> "AccInline",None | AccRequire(s,so) -> "AccRequire",Some (jobject ["require",jstring s;"message",jopt jstring so]) @@ -531,10 +552,11 @@ and generate_class_field' ctx cfs cf = jnull in [ - "name",jstring cf.cf_name; + "name",jstring (field_name cf.cf_name cf.cf_meta); "type",generate_type ctx cf.cf_type; "isPublic",jbool (has_class_field_flag cf CfPublic); "isFinal",jbool (has_class_field_flag cf CfFinal); + "isAbstract",jbool (has_class_field_flag cf CfAbstract); "params",jlist (generate_type_parameter ctx) cf.cf_params; "meta",generate_metadata ctx cf.cf_meta; "kind",generate_class_kind (); @@ -550,7 +572,7 @@ and generate_class_field ctx cfs cf = let generate_enum_field ctx ef = jobject [ - "name",jstring ef.ef_name; + "name",jstring (field_name ef.ef_name ef.ef_meta); "type",generate_type ctx ef.ef_type; "pos",generate_pos ctx ef.ef_pos; "meta",generate_metadata ctx ef.ef_meta; @@ -580,31 +602,33 @@ let generate_class ctx c = | KTypeParameter tl -> "KTypeParameter",Some (generate_types ctx tl) | KExpr e -> "KExpr",Some (generate_expr ctx e) | KGeneric -> "KGeneric",None - | KGenericInstance(c,tl) -> "KGenericInstance",Some (generate_type_path_with_params ctx c.cl_module.m_path c.cl_path tl) + | KGenericInstance(c,tl) -> "KGenericInstance",Some (generate_type_path_with_params ctx c.cl_module.m_path c.cl_path tl c.cl_meta) | KMacroType -> "KMacroType",None | KGenericBuild _ -> "KGenericBuild",None | KAbstractImpl a -> "KAbstractImpl",Some (abstract_ref ctx a) + | KModuleFields m -> "KModuleFields",Some (generate_module_path m.m_path) in generate_adt ctx (Some (["haxe";"macro"],"ClassKind")) ctor args in let generate_class_relation (c,tl) = jobject [ - "t",class_ref ctx c; + "path",class_ref ctx c; "params",generate_types ctx tl; ] in [ "kind",generate_class_kind c.cl_kind; - "isInterface",jbool c.cl_interface; + "isInterface",jbool (has_class_flag c CInterface); "superClass",jopt generate_class_relation c.cl_super; "interfaces",jlist generate_class_relation c.cl_implements; "fields",jlist (generate_class_field ctx CFSMember) c.cl_ordered_fields; "statics",jlist (generate_class_field ctx CFSStatic) c.cl_ordered_statics; "constructor",jopt (generate_class_field ctx CFSConstructor) c.cl_constructor; "init",jopt (generate_texpr ctx) c.cl_init; - "overrides",jlist (classfield_ref ctx) c.cl_overrides; - "isExtern",jbool c.cl_extern; - "isFinal",jbool c.cl_final; + "overrides",jlist (classfield_ref ctx) (List.filter (fun cf -> has_class_field_flag cf CfOverride) c.cl_ordered_fields); + "isExtern",jbool (has_class_flag c CExtern); + "isFinal",jbool (has_class_flag c CFinal); + "isAbstract",jbool (has_class_flag c CAbstract); ] let generate_enum ctx e = @@ -684,8 +708,8 @@ let generate_module ctx m = jobject [ "id",jint m.m_id; "path",generate_module_path m.m_path; - "types",jlist (fun mt -> generate_type_path m.m_path (t_infos mt).mt_path) m.m_types; - "file",jstring m.m_extra.m_file; + "types",jlist (fun mt -> generate_type_path m.m_path (t_infos mt).mt_path (t_infos mt).mt_meta) m.m_types; + "file",jstring (Path.UniqueKey.lazy_path m.m_extra.m_file); "sign",jstring (Digest.to_hex m.m_extra.m_sign); "dependencies",jarray (PMap.fold (fun m acc -> (jobject [ "path",jstring (s_type_path m.m_path); diff --git a/src/core/path.ml b/src/core/path.ml index eb3976d8..e41fb022 100644 --- a/src/core/path.ml +++ b/src/core/path.ml @@ -84,8 +84,93 @@ let normalize_path path = let path_sep = if Globals.is_windows then "\\" else "/" -(** Returns absolute path. Doesn't fix path case on Windows. *) -let get_full_path f = try Extc.get_full_path f with _ -> f +let is_absolute_path f = + try + match f.[0] with + | '/' -> true + | 'A'..'Z' | 'a'..'z' -> Globals.is_windows && f.[1] = ':' + | '\\' -> Globals.is_windows + | _ -> false + with _ -> + false + +(** + Returns absolute path. + Resolves `.`, `..`, double slashes and trailing slashesw. + Doesn't resolve symbolic links. + Doesn't fix path case on Windows. + Doesn't access file system (see https://github.com/HaxeFoundation/haxe/issues/9509#issuecomment-636360777) +*) +let get_full_path = + if Globals.is_windows then + (fun f -> try Extc.get_full_path f with _ -> f) + else + (fun f -> + let length = String.length f in + let rec skip_past_slash i = + if i >= length then + i + else + match String.unsafe_get f i with + | '/' -> i + 1 + | _ -> skip_past_slash (i + 1) + in + let rec has_dots_or_double_slash i = + if i >= length then + false + else + let has = + match String.unsafe_get f i with + | '.' -> + if i + 2 < length then + match String.unsafe_get f (i + 1), String.unsafe_get f (i + 2) with + | '.', '/' | '/', _ -> true (* path contains `../` or `./` *) + | _ -> false + else if i + 1 < length then + match String.unsafe_get f (i + 1) with + | '/' | '.' -> true (* path ends with `./` or `..` *) + | _ -> false + else + true (* path ends with `.` *) + | '/' when i > 0 -> (* double slash *) + true + | _ -> + false + in + if has then true + else has_dots_or_double_slash (skip_past_slash i) + in + let absolute_path = + if length > 0 && String.unsafe_get f 0 = '/' then f + else if length = 0 then Unix.getcwd() + else (Unix.getcwd()) ^ "/" ^ f + in + let has_trailing_slash = + length > 0 && String.unsafe_get f (length - 1) = '/' + in + if not has_trailing_slash && not (has_dots_or_double_slash 0) then + absolute_path + else begin + let parts = ExtString.String.split_on_char '/' absolute_path in + let skip = ref 0 in + let normalized_parts = + List.fold_left (fun acc current -> + match current with + | ".." -> + incr skip; + acc + | "." | "" -> + acc + | _ when !skip > 0 -> + decr skip; + acc + | _ -> + current :: acc + ) [] (List.rev parts) + in + "/" ^ String.concat "/" normalized_parts + end + ) (** Returns absolute path (on Windows ensures proper case with drive letter upper-cased) Use for returning positions from IDE support functions *) @@ -93,15 +178,32 @@ let get_real_path = if Globals.is_windows then (fun p -> try Extc.get_real_path p with _ -> p) else - get_full_path + (fun p -> try Extc.get_full_path p with _ -> p) module UniqueKey : sig + (** + Stores a unique key for a file path. + *) type t + (** + Stores an original file path along with a lazily-calculated key. + *) + type lazy_t (** Returns absolute path guaranteed to be the same for different letter case. Use where equality comparison is required, lowercases the path on Windows *) val create : string -> t + + val create_lazy : string -> lazy_t + (** + Calculates a key or retrieve a cached key. + *) + val lazy_key : lazy_t -> t + (** + Returns original path, which was used to create `lazy_t` + *) + val lazy_path : lazy_t -> string (** Check if the first key starts with the second key *) @@ -110,14 +212,35 @@ module UniqueKey : sig Get string representation of a key *) val to_string : t -> string + end = struct + type t = string + + type lazy_t = string * string option ref + + (* type file_key *) + let create = if Globals.is_windows then (fun f -> String.lowercase (get_full_path f)) else get_full_path + let create_lazy f = + (f, ref None) + + let lazy_key l = + match l with + | f,{ contents = Some key } -> key + | f,k -> + let key = create f in + k := Some key; + key + + let lazy_path l = + fst l + let starts_with subj start = ExtString.String.starts_with subj start diff --git a/src/core/tFunctions.ml b/src/core/tFunctions.ml index ea4825a4..463cf302 100644 --- a/src/core/tFunctions.ml +++ b/src/core/tFunctions.ml @@ -4,6 +4,7 @@ open TType let monomorph_create_ref : (unit -> tmono) ref = ref (fun _ -> die "" __LOC__) let monomorph_bind_ref : (tmono -> t -> unit) ref = ref (fun _ _ -> die "" __LOC__) +let monomorph_classify_constraints_ref : (tmono -> tmono_constraint_kind) ref = ref (fun _ -> die "" __LOC__) let has_meta m ml = List.exists (fun (m2,_,_) -> m = m2) ml let get_meta m ml = List.find (fun (m2,_,_) -> m = m2) ml @@ -19,6 +20,18 @@ let set_flag flags flag = let unset_flag flags flag = flags land (lnot (1 lsl flag)) +let int_of_class_flag (flag : flag_tclass) = + Obj.magic flag + +let add_class_flag c (flag : flag_tclass) = + c.cl_flags <- set_flag c.cl_flags (int_of_class_flag flag) + +let remove_class_flag c (flag : flag_tclass) = + c.cl_flags <- unset_flag c.cl_flags (int_of_class_flag flag) + +let has_class_flag c (flag : flag_tclass) = + has_flag c.cl_flags (int_of_class_flag flag) + let int_of_class_field_flag (flag : flag_tclass_field) = Obj.magic flag @@ -31,6 +44,18 @@ let remove_class_field_flag cf (flag : flag_tclass_field) = let has_class_field_flag cf (flag : flag_tclass_field) = has_flag cf.cf_flags (int_of_class_field_flag flag) +let int_of_var_flag (flag : flag_tvar) = + Obj.magic flag + +let add_var_flag v (flag : flag_tvar) = + v.v_flags <- set_flag v.v_flags (int_of_var_flag flag) + +let remove_var_flag v (flag : flag_tvar) = + v.v_flags <- unset_flag v.v_flags (int_of_var_flag flag) + +let has_var_flag v (flag : flag_tvar) = + has_flag v.v_flags (int_of_var_flag flag) + (* ======= General utility ======= *) let alloc_var = @@ -42,11 +67,10 @@ let alloc_var = v_name = n; v_type = t; v_id = !uid; - v_capture = false; - v_final = (match kind with VUser TVOLocalFunction -> true | _ -> false); v_extra = None; v_meta = []; - v_pos = p + v_pos = p; + v_flags = (match kind with VUser TVOLocalFunction -> int_of_var_flag VFinal | _ -> 0); } ) @@ -93,9 +117,7 @@ let mk_class m path pos name_pos = cl_meta = []; cl_private = false; cl_kind = KNormal; - cl_extern = false; - cl_final = false; - cl_interface = false; + cl_flags = 0; cl_params = []; cl_using = []; cl_super = None; @@ -108,24 +130,14 @@ let mk_class m path pos name_pos = cl_array_access = None; cl_constructor = None; cl_init = None; - cl_overrides = []; cl_build = (fun() -> Built); cl_restore = (fun() -> ()); cl_descendants = []; } let module_extra file sign time kind policy = - let file_key = ref None in { - m_file = file; - m_file_key = (fun () -> - match !file_key with - | Some key -> key - | None -> - let key = Path.UniqueKey.create file in - file_key := Some key; - key - ); + m_file = Path.UniqueKey.create_lazy file; m_sign = sign; m_display = { m_inline_calls = []; @@ -168,6 +180,7 @@ let null_module = { m_id = alloc_mid(); m_path = [] , ""; m_types = []; + m_statics = None; m_extra = module_extra "" "" 0. MFake []; } @@ -199,6 +212,7 @@ let null_abstract = { a_array = []; a_read = None; a_write = None; + a_enum = false; } let add_dependency m mdep = @@ -240,7 +254,7 @@ let map loop t = (match r.tm_type with | None -> t | Some t -> loop t) (* erase*) - | TEnum (_,[]) | TInst (_,[]) | TType (_,[]) -> + | TEnum (_,[]) | TInst (_,[]) | TType (_,[]) | TAbstract (_,[]) -> t | TEnum (e,tl) -> TEnum (e, List.map loop tl) @@ -254,13 +268,7 @@ let map loop t = TFun (List.map (fun (s,o,t) -> s, o, loop t) tl,loop r) | TAnon a -> let fields = PMap.map (fun f -> { f with cf_type = loop f.cf_type }) a.a_fields in - begin match !(a.a_status) with - | Opened -> - a.a_fields <- fields; - t - | _ -> - mk_anon ~fields a.a_status - end + mk_anon ~fields a.a_status | TLazy f -> let ft = lazy_type f in let ft2 = loop ft in @@ -268,6 +276,33 @@ let map loop t = | TDynamic t2 -> if t == t2 then t else TDynamic (loop t2) +let iter loop t = + match t with + | TMono r -> + (match r.tm_type with + | None -> () + | Some t -> loop t) + | TEnum (_,[]) | TInst (_,[]) | TType (_,[]) -> + () + | TEnum (e,tl) -> + List.iter loop tl + | TInst (c,tl) -> + List.iter loop tl + | TType (t2,tl) -> + List.iter loop tl + | TAbstract (a,tl) -> + List.iter loop tl + | TFun (tl,r) -> + List.iter (fun (_,_,t) -> loop t) tl; + loop r + | TAnon a -> + PMap.iter (fun _ f -> loop f.cf_type) a.a_fields + | TLazy f -> + let ft = lazy_type f in + loop ft + | TDynamic t2 -> + if t != t2 then loop t2 + let duplicate t = let monos = ref [] in let rec loop t = @@ -384,13 +419,7 @@ let apply_params ?stack cparams params t = TFun (List.map (fun (s,o,t) -> s, o, loop t) tl,loop r) | TAnon a -> let fields = PMap.map (fun f -> { f with cf_type = loop f.cf_type }) a.a_fields in - begin match !(a.a_status) with - | Opened -> - a.a_fields <- fields; - t - | _ -> - mk_anon ~fields a.a_status - end + mk_anon ~fields a.a_status | TLazy f -> let ft = lazy_type f in let ft2 = loop ft in @@ -463,28 +492,22 @@ let rec follow_without_null t = follow_without_null (apply_params t.t_params tl t.t_type) | _ -> t -(** Assumes `follow` has already been applied *) -let rec ambiguate_funs t = +let rec follow_without_type t = match t with - | TFun _ -> TFun ([], t_dynamic) | TMono r -> (match r.tm_type with - | Some _ -> die "" __LOC__ + | Some t -> follow_without_type t | _ -> t) - | TInst (a, pl) -> - TInst (a, List.map ambiguate_funs pl) - | TEnum (a, pl) -> - TEnum (a, List.map ambiguate_funs pl) - | TAbstract (a, pl) -> - TAbstract (a, List.map ambiguate_funs pl) - | TType (a, pl) -> - TType (a, List.map ambiguate_funs pl) - | TDynamic _ -> t - | TAnon a -> - TAnon { a with a_fields = - PMap.map (fun af -> { af with cf_type = - ambiguate_funs af.cf_type }) a.a_fields } - | TLazy _ -> die "" __LOC__ + | TLazy f -> + follow_without_type (lazy_type f) + | TAbstract({a_path = [],"Null"},[t]) -> + follow_without_type t + | _ -> t + +let rec ambiguate_funs t = + match follow t with + | TFun _ -> TFun ([], t_dynamic) + | _ -> map ambiguate_funs t let rec is_nullable ?(no_lazy=false) = function | TMono r -> @@ -569,8 +592,6 @@ let concat e1 e2 = ) in mk e e2.etype (punion e1.epos e2.epos) -let is_closed a = !(a.a_status) <> Opened - let type_of_module_type = function | TClassDecl c -> TInst (c,List.map snd c.cl_params) | TEnumDecl e -> TEnum (e,List.map snd e.e_params) @@ -676,7 +697,7 @@ let rec raw_class_field build_type c tl i = in loop tl | _ -> - if not c.cl_interface then raise Not_found; + if not (has_class_flag c CInterface) then raise Not_found; (* an interface can implements other interfaces without having to redeclare its fields @@ -728,20 +749,30 @@ let quick_field_dynamic t s = try quick_field t s with Not_found -> FDynamic s -let rec get_constructor build_type c = +let rec get_constructor_class c tl = match c.cl_constructor, c.cl_super with - | Some c, _ -> build_type c, c + | Some cf, _ -> (cf,c,tl) | None, None -> raise Not_found - | None, Some (csup,cparams) -> - let t, c = get_constructor build_type csup in - apply_params csup.cl_params cparams t, c + | None, Some (csup,tlsup) -> get_constructor_class csup (List.map (apply_params c.cl_params tl) tlsup) + +let rec get_constructor c = + match c.cl_constructor, c.cl_super with + | Some c, _ -> c + | None, None -> raise Not_found + | None, Some (csup,_) -> get_constructor csup let has_constructor c = try - ignore(get_constructor (fun cf -> cf.cf_type) c); + ignore(get_constructor c); true with Not_found -> false +let is_module_fields_class c = + match c.cl_kind with KModuleFields _ -> true | _ -> false + +let is_pos_outside_class c p = + p.pfile <> c.cl_pos.pfile || p.pmax < c.cl_pos.pmin || p.pmin > c.cl_pos.pmax + let resolve_typedef t = match t with | TClassDecl _ | TEnumDecl _ | TAbstractDecl _ -> t @@ -764,3 +795,9 @@ let type_has_meta t m = | TType ({ t_meta = metadata }, _) | TAbstract ({ a_meta = metadata }, _) -> has_meta m metadata +(* tvar *) + +let var_extra params e = { + v_params = params; + v_expr = e; +} \ No newline at end of file diff --git a/src/core/tOther.ml b/src/core/tOther.ml index b66cbe15..9851f9c8 100644 --- a/src/core/tOther.ml +++ b/src/core/tOther.ml @@ -103,7 +103,10 @@ module TExprToExpr = struct let arg (v,c) = (v.v_name,v.v_pos), false, v.v_meta, mk_type_hint v.v_type null_pos, (match c with None -> None | Some c -> Some (convert_expr c)) in EFunction (FKAnonymous,{ f_params = []; f_args = List.map arg f.tf_args; f_type = mk_type_hint f.tf_type null_pos; f_expr = Some (convert_expr f.tf_expr) }) | TVar (v,eo) -> - EVars ([(v.v_name,v.v_pos), v.v_final, mk_type_hint v.v_type v.v_pos, eopt eo]) + let final = has_var_flag v VFinal + and t = mk_type_hint v.v_type v.v_pos + and eo = eopt eo in + EVars ([mk_evar ~final ?t ?eo ~meta:v.v_meta (v.v_name,v.v_pos)]) | TBlock el -> EBlock (List.map convert_expr el) | TFor (v,it,e) -> let ein = (EBinop (OpIn,(EConst (Ident v.v_name),it.epos),convert_expr it),it.epos) in @@ -177,6 +180,16 @@ module ExtType = struct | TAbstract({a_path=[],"Bool"},_) -> true | _ -> false + let is_rest t = match t with + | TType({t_path=["haxe"; "extern"],"Rest"},_) + | TAbstract({a_path=["haxe"],"Rest"},_) -> true + | _ -> false + + let is_type_param t = + match t with + | TInst({ cl_kind = KTypeParameter _ }, _) -> true + | _ -> false + type semantics = | VariableSemantics | ReferenceSemantics @@ -264,7 +277,7 @@ module TClass = struct end else acc in let acc = if self_too || c != c0 then List.fold_left maybe_add acc c.cl_ordered_fields else acc in - if c.cl_interface then + if (has_class_flag c CInterface) then List.fold_left (fun acc (i,tl) -> loop acc i (List.map apply tl)) acc c.cl_implements else match c.cl_super with @@ -292,6 +305,27 @@ module TClass = struct end in loop [] c + + let add_field c cf = + let is_static = has_class_field_flag cf CfStatic in + if is_static then begin + c.cl_statics <- PMap.add cf.cf_name cf c.cl_statics; + c.cl_ordered_statics <- cf :: c.cl_ordered_statics; + end else begin + c.cl_fields <- PMap.add cf.cf_name cf c.cl_fields; + c.cl_ordered_fields <- cf :: c.cl_ordered_fields; + end + + let get_map_function c tl = + let rec loop map c = match c.cl_super with + | Some(csup,tl) -> + let map t = map (apply_params csup.cl_params tl t) in + loop map csup + | None -> + map + in + let apply = apply_params c.cl_params tl in + loop apply c end let s_class_path c = diff --git a/src/core/tPrinting.ml b/src/core/tPrinting.ml index c8bbdb96..1aa7f3a3 100644 --- a/src/core/tPrinting.ml +++ b/src/core/tPrinting.ml @@ -39,7 +39,12 @@ let rec s_type ctx t = with Not_found -> let id = List.length !ctx in ctx := (t,id) :: !ctx; - Printf.sprintf "Unknown<%d>" id + let s_const = match !monomorph_classify_constraints_ref r with + | CUnknown -> "" + | CTypes tl -> " : " ^ String.concat " & " (List.map (fun (t,_) -> s_type ctx t) tl) + | CStructural(fields,_) -> " : " ^ s_type ctx (mk_anon ~fields (ref Closed)) + in + Printf.sprintf "Unknown<%d>%s" id s_const end | Some t -> s_type ctx t) | TEnum (e,tl) -> @@ -55,7 +60,7 @@ let rec s_type ctx t = | TAbstract (a,tl) -> s_type_path a.a_path ^ s_type_params ctx tl | TFun ([],t) -> - "Void -> " ^ s_fun ctx t false + "() -> " ^ s_fun ctx t false | TFun (l,t) -> let args = match l with | [] -> "()" @@ -75,7 +80,7 @@ let rec s_type ctx t = | AbstractStatics a -> Printf.sprintf "{ AbstractStatics %s }" (s_type_path a.a_path) | _ -> let fl = PMap.fold (fun f acc -> ((if Meta.has Meta.Optional f.cf_meta then " ?" else " ") ^ f.cf_name ^ " : " ^ s_type ctx f.cf_type) :: acc) a.a_fields [] in - "{" ^ (if not (is_closed a) then "+" else "") ^ String.concat "," fl ^ " }" + "{" ^ String.concat "," fl ^ " }" end | TDynamic t2 -> "Dynamic" ^ s_type_params ctx (if t == t2 then [] else [t2]) @@ -101,11 +106,17 @@ and s_type_params ctx = function | [] -> "" | l -> "<" ^ String.concat ", " (List.map (s_type ctx) l) ^ ">" +and s_constraint = function + | MMono(m,_) -> Printf.sprintf "MMono %s" (s_type_kind (TMono m)) + | MField cf -> Printf.sprintf "MField %s" cf.cf_name + | MType(t,_) -> Printf.sprintf "MType %s" (s_type_kind t) + | MOpenStructure -> "MOpenStructure" + | MEmptyStructure -> "MEmptyStructure" + let s_access is_read = function | AccNormal -> "default" | AccNo -> "null" | AccNever -> "never" - | AccResolve -> "resolve" | AccCall -> if is_read then "get" else "set" | AccInline -> "inline" | AccRequire (n,_) -> "require " ^ n @@ -174,7 +185,7 @@ let rec s_expr s_type e = let sprintf = Printf.sprintf in let slist f l = String.concat "," (List.map f l) in let loop = s_expr s_type in - let s_var v = v.v_name ^ ":" ^ string_of_int v.v_id ^ if v.v_capture then "[c]" else "" in + let s_var v = v.v_name ^ ":" ^ string_of_int v.v_id ^ if has_var_flag v VCaptured then "[c]" else "" in let str = (match e.eexpr with | TConst c -> "Const " ^ s_const c @@ -429,6 +440,8 @@ let s_class_kind = function "KGenericBuild" | KAbstractImpl a -> Printf.sprintf "KAbstractImpl %s" (s_type_path a.a_path) + | KModuleFields m -> + Printf.sprintf "KModuleFields %s" (s_type_path m.m_path) module Printer = struct @@ -473,7 +486,7 @@ module Printer = struct | TInst({cl_kind = KTypeParameter tl1},tl2) -> begin match tl1 with | [] -> s - | _ -> Printf.sprintf "%s:%s" s (String.concat ", " (List.map s_type tl1)) + | _ -> Printf.sprintf "%s:%s" s (String.concat " & " (List.map s_type tl1)) end | _ -> die "" __LOC__ @@ -504,13 +517,9 @@ module Printer = struct "cl_meta",s_metadata c.cl_meta; "cl_params",s_type_params c.cl_params; "cl_kind",s_class_kind c.cl_kind; - "cl_extern",string_of_bool c.cl_extern; - "cl_final",string_of_bool c.cl_final; - "cl_interface",string_of_bool c.cl_interface; "cl_super",s_opt (fun (c,tl) -> s_type (TInst(c,tl))) c.cl_super; "cl_implements",s_list ", " (fun (c,tl) -> s_type (TInst(c,tl))) c.cl_implements; "cl_array_access",s_opt s_type c.cl_array_access; - "cl_overrides",s_list "," (fun cf -> cf.cf_name) c.cl_overrides; "cl_init",s_opt (s_expr_ast true "" s_type) c.cl_init; "cl_constructor",s_opt (s_tclass_field (tabs ^ "\t")) c.cl_constructor; "cl_ordered_fields",s_list "\n\t" (s_tclass_field (tabs ^ "\t")) c.cl_ordered_fields; @@ -581,15 +590,15 @@ module Printer = struct "a_write",s_opt (fun cf -> cf.cf_name) a.a_write; ] - let s_tvar_extra (tl,eo) = - Printf.sprintf "Some(%s, %s)" (s_type_params tl) (s_opt (s_expr_ast true "" s_type) eo) + let s_tvar_extra ve = + Printf.sprintf "Some(%s, %s)" (s_type_params ve.v_params) (s_opt (s_expr_ast true "" s_type) ve.v_expr) let s_tvar v = s_record_fields "" [ "v_id",string_of_int v.v_id; "v_name",v.v_name; "v_type",s_type v.v_type; - "v_capture",string_of_bool v.v_capture; + "v_capture",string_of_bool (has_var_flag v VCaptured); "v_extra",s_opt s_tvar_extra v.v_extra; "v_meta",s_metadata v.v_meta; "v_pos",s_pos v.v_pos; @@ -604,7 +613,7 @@ module Printer = struct let s_module_def_extra tabs me = s_record_fields tabs [ - "m_file",me.m_file; + "m_file",Path.UniqueKey.lazy_path me.m_file; "m_sign",me.m_sign; "m_time",string_of_float me.m_time; "m_dirty",s_opt s_type_path me.m_dirty; @@ -640,6 +649,7 @@ module Printer = struct | HExtends tp -> "HExtends " ^ (s_type_path (fst tp)) | HImplements tp -> "HImplements " ^ (s_type_path (fst tp)) | HFinal -> "HFinal" + | HAbstract -> "HAbstract" let s_placed f (x,p) = s_pair (f x) (s_pos p) diff --git a/src/core/tType.ml b/src/core/tType.ml index 6ce56c4e..0784690f 100644 --- a/src/core/tType.ml +++ b/src/core/tType.ml @@ -15,7 +15,6 @@ and var_access = | AccNo (* can't be accessed outside of the class itself and its subclasses *) | AccNever (* can't be accessed, even in subclasses *) | AccCtor (* can only be accessed from the constructor *) - | AccResolve (* call resolve("field") when accessed *) | AccCall (* perform a method call when accessed *) | AccInline (* similar to Normal but inline when accessed *) | AccRequire of string * string option (* set when @:require(cond) fails *) @@ -45,8 +44,21 @@ type t = and tmono = { mutable tm_type : t option; + mutable tm_constraints : tmono_constraint list; } +and tmono_constraint = + | MMono of tmono * string option + | MField of tclass_field + | MType of t * string option + | MOpenStructure + | MEmptyStructure + +and tmono_constraint_kind = + | CUnknown + | CStructural of (string,tclass_field) PMap.t * bool + | CTypes of (t * string option) list + and tlazy = | LAvailable of t | LProcessing of (unit -> t) @@ -67,7 +79,10 @@ and tconstant = | TThis | TSuper -and tvar_extra = (type_params * texpr option) option +and tvar_extra = { + v_params : type_params; + v_expr : texpr option; +} and tvar_origin = | TVOLocalVariable @@ -89,10 +104,9 @@ and tvar = { mutable v_name : string; mutable v_type : t; mutable v_kind : tvar_kind; - mutable v_capture : bool; - mutable v_final : bool; - mutable v_extra : tvar_extra; + mutable v_extra : tvar_extra option; mutable v_meta : metadata; + mutable v_flags : int; v_pos : pos; } @@ -104,7 +118,6 @@ and tfunc = { and anon_status = | Closed - | Opened | Const | Extend of t list | Statics of tclass @@ -185,6 +198,7 @@ and tclass_kind = | KMacroType | KGenericBuild of class_field list | KAbstractImpl of tabstract + | KModuleFields of module_def and metadata = Ast.metadata @@ -212,9 +226,7 @@ and tclass = { mutable cl_using : (tclass * pos) list; (* do not insert any fields above *) mutable cl_kind : tclass_kind; - mutable cl_extern : bool; - mutable cl_final : bool; - mutable cl_interface : bool; + mutable cl_flags : int; mutable cl_super : (tclass * tparams) option; mutable cl_implements : (tclass * tparams) list; mutable cl_fields : (string, tclass_field) PMap.t; @@ -225,7 +237,6 @@ and tclass = { mutable cl_array_access : t option; mutable cl_constructor : tclass_field option; mutable cl_init : texpr option; - mutable cl_overrides : tclass_field list; mutable cl_build : unit -> build_state; mutable cl_restore : unit -> unit; @@ -237,11 +248,11 @@ and tclass = { } and tenum_field = { - ef_name : string; + mutable ef_name : string; mutable ef_type : t; ef_pos : pos; ef_name_pos : pos; - ef_doc : Ast.documentation; + mutable ef_doc : Ast.documentation; ef_index : int; mutable ef_params : type_params; mutable ef_meta : metadata; @@ -253,7 +264,7 @@ and tenum = { e_pos : pos; e_name_pos : pos; e_private : bool; - e_doc : Ast.documentation; + mutable e_doc : Ast.documentation; mutable e_meta : metadata; mutable e_params : type_params; mutable e_using : (tclass * pos) list; @@ -284,7 +295,7 @@ and tabstract = { a_pos : pos; a_name_pos : pos; a_private : bool; - a_doc : Ast.documentation; + mutable a_doc : Ast.documentation; mutable a_meta : metadata; mutable a_params : type_params; mutable a_using : (tclass * pos) list; @@ -300,6 +311,7 @@ and tabstract = { mutable a_array : tclass_field list; mutable a_read : tclass_field option; mutable a_write : tclass_field option; + a_enum : bool; } and module_type = @@ -312,6 +324,7 @@ and module_def = { m_id : int; m_path : path; mutable m_types : module_type list; + mutable m_statics : tclass option; m_extra : module_def_extra; } @@ -322,8 +335,7 @@ and module_def_display = { } and module_def_extra = { - m_file : string; - m_file_key : unit -> Path.UniqueKey.t; + m_file : Path.UniqueKey.lazy_t; m_sign : string; m_display : module_def_display; mutable m_check_policy : module_check_policy list; @@ -366,9 +378,28 @@ type class_field_scope = | CFSMember | CFSConstructor +type flag_tclass = + | CExtern + | CFinal + | CInterface + | CAbstract + type flag_tclass_field = | CfPublic | CfStatic | CfExtern (* This is only set if the field itself is extern, not just the class. *) | CfFinal - | CfModifiesThis (* This is set for methods which reassign `this`. E.g. `this = value` *) \ No newline at end of file + | CfModifiesThis (* This is set for methods which reassign `this`. E.g. `this = value` *) + | CfOverride + | CfAbstract + | CfOverload + | CfImpl + | CfEnum + | CfGeneric + +type flag_tvar = + | VCaptured + | VFinal + | VUsed (* used by the analyzer *) + | VAssigned + | VCaught diff --git a/src/core/tUnification.ml b/src/core/tUnification.ml index 1bb7d8f7..e48f1b7a 100644 --- a/src/core/tUnification.ml +++ b/src/core/tUnification.ml @@ -3,22 +3,244 @@ open TType open TFunctions open TPrinting +type unify_error = + | Cannot_unify of t * t + | Invalid_field_type of string + | Has_no_field of t * string + | Has_no_runtime_field of t * string + | Has_extra_field of t * string + | Invalid_kind of string * field_kind * field_kind + | Invalid_visibility of string + | Not_matching_optional of string + | Cant_force_optional + | Invariant_parameter of int + | Constraint_failure of string + | Missing_overload of tclass_field * t + | FinalInvariance (* nice band name *) + | Invalid_function_argument of int (* index *) * int (* total *) + | Invalid_return_type + | Unify_custom of string + +exception Unify_error of unify_error list + +type eq_kind = + | EqStrict + | EqCoreType + | EqRightDynamic + | EqBothDynamic + | EqDoNotFollowNull (* like EqStrict, but does not follow Null *) + +type unification_context = { + allow_transitive_cast : bool; + allow_abstract_cast : bool; (* allows a non-transitive abstract cast (from,to,@:from,@:to) *) + allow_dynamic_to_cast : bool; (* allows a cast from dynamic to non-dynamic *) + equality_kind : eq_kind; + equality_underlying : bool; +} + +type unify_min_result = + | UnifyMinOk of t + | UnifyMinError of unify_error list * int + +let error l = raise (Unify_error l) + +let check_constraint name f = + try + f() + with Unify_error l -> + raise (Unify_error ((Constraint_failure name) :: l)) + +let unify_ref : (unification_context -> t -> t -> unit) ref = ref (fun _ _ _ -> ()) +let unify_min_ref : (unification_context -> t -> t list -> unify_min_result) ref = ref (fun _ _ _ -> assert false) + +let default_unification_context = { + allow_transitive_cast = true; + allow_abstract_cast = true; + allow_dynamic_to_cast = true; + equality_kind = EqStrict; + equality_underlying = false; +} + module Monomorph = struct let create () = { tm_type = None; + tm_constraints = []; } + (* constraining *) + + let add_constraint m constr = + m.tm_constraints <- constr :: m.tm_constraints + + let constraint_of_type name t = match follow t with + | TMono m2 -> + [MMono(m2,name)] + | TAnon an when not (PMap.is_empty an.a_fields) -> + PMap.fold (fun cf l -> + (MField cf) :: l + ) an.a_fields [] + | TAnon _ -> + [MEmptyStructure] + | _ -> + [MType(t,name)] + + let constrain_to_type m name t = + List.iter (add_constraint m) (constraint_of_type name t) + + (* Note: This function is called by printing and others and should thus not modify state. *) + + let rec classify_constraints' m = + let types = DynArray.create () in + let fields = ref PMap.empty in + let is_open = ref false in + let monos = ref [] in + let rec check constr = match constr with + | MMono(m2,name) -> + begin match m2.tm_type with + | None -> + let more_monos,kind = classify_constraints' m2 in + monos := !monos @ more_monos; + begin match kind with + | CUnknown -> + (* Collect unconstrained monomorphs because we have to bind them. *) + monos := m2 :: !monos; + | _ -> + (* Recursively inherit constraints. *) + List.iter check m2.tm_constraints + end + | Some t -> + List.iter (fun constr -> check constr) (constraint_of_type name t) + end; + | MField cf -> + fields := PMap.add cf.cf_name cf !fields; + | MType(t2,name) -> + DynArray.add types (t2,name) + | MOpenStructure + | MEmptyStructure -> + is_open := true + in + List.iter check m.tm_constraints; + let kind = + if DynArray.length types > 0 then + CTypes (DynArray.to_list types) + else if not (PMap.is_empty !fields) || !is_open then + CStructural(!fields,!is_open) + else + CUnknown + in + !monos,kind + + let classify_constraints m = snd (classify_constraints' m) + + let check_constraints constr t = + match constr with + | CUnknown -> + () + | CTypes tl -> + List.iter (fun (t2,name) -> + let f () = (!unify_ref) default_unification_context t t2 in + match name with + | Some name -> check_constraint name f + | None -> f() + ) tl + | CStructural(fields,is_open) -> + let t2 = mk_anon ~fields (ref Closed) in + (!unify_ref) default_unification_context t t2 + + (* binding *) + let do_bind m t = (* assert(m.tm_type = None); *) (* TODO: should be here, but matcher.ml does some weird bind handling at the moment. *) - m.tm_type <- Some t + m.tm_type <- Some t; + m.tm_constraints <- [] let rec bind m t = - m.tm_type <- Some t + begin match t with + | TAnon _ when List.mem MOpenStructure m.tm_constraints -> + (* If we assign an open structure monomorph to another structure, the semantics want us to merge the + fields. This is kinda weird, but that's how it has always worked. *) + constrain_to_type m None t; + ignore(close m) + | TMono m2 -> + if m != m2 then begin match m2.tm_type with + | None -> + List.iter (fun constr -> m2.tm_constraints <- constr :: m2.tm_constraints) m.tm_constraints; + do_bind m t; + | Some t -> + bind m t + end + | _ -> + (* Due to recursive constraints like in #9603, we tentatively bind the monomorph to the type we're checking + against before checking the constraints. *) + m.tm_type <- Some t; + let monos,kind = classify_constraints' m in + Std.finally (fun () -> m.tm_type <- None) (fun () -> check_constraints kind t) (); + (* If the monomorph we're binding to has other yet unbound monomorphs, constrain them to our target type (issue #9640) .*) + List.iter (fun m2 -> + constrain_to_type m2 None t; + ) monos; + do_bind m t + end + + and close m = match m.tm_type with + | Some _ -> + () + | None -> match classify_constraints m with + | CUnknown -> + () + | CTypes [(t,_)] -> + do_bind m t; + () + | CTypes _ -> + () + | CStructural(fields,_) -> + let check_recursion cf = + let rec loop t = match t with + | TMono m2 when m == m2 -> + let pctx = print_context() in + let s = Printf.sprintf "%s appears in { %s: %s }" (s_type pctx t) cf.cf_name (s_type pctx cf.cf_type) in + raise (Unify_error [Unify_custom "Recursive type";Unify_custom s]); + | _ -> + TFunctions.map loop t + in + ignore(loop cf.cf_type); + in + (* We found a bunch of fields but no type, create a merged structure type and bind to that *) + PMap.iter (fun _ cf -> check_recursion cf) fields; + do_bind m (mk_anon ~fields (ref Closed)); + () let unbind m = m.tm_type <- None + + let spawn_constrained_monos map params = + let checks = DynArray.create () in + let monos = List.map (fun (s,t) -> + let mono = create() in + begin match follow t with + | TInst ({ cl_kind = KTypeParameter constr; cl_path = path },_) when constr <> [] -> + DynArray.add checks (mono,constr,s_type_path path) + | _ -> + () + end; + TMono mono + ) params in + let map t = map (apply_params params monos t) in + DynArray.iter (fun (mono,constr,path) -> + List.iter (fun t -> constrain_to_type mono (Some path) (map t)) constr + ) checks; + monos + end +let rec follow_and_close t = match follow t with + | TMono r as t -> + Monomorph.close r; + if r.tm_type <> None then follow_and_close t + else t + | t -> + t + let rec link e a b = (* tell if setting a == b will create a type-loop *) let rec loop t = @@ -53,19 +275,6 @@ let rec link e a b = true end -let would_produce_recursive_anon field_acceptor field_donor = - try - (match !(field_acceptor.a_status) with - | Opened -> - PMap.iter (fun n field -> - match follow field.cf_type with - | TAnon a when field_acceptor == a -> raise Exit - | _ -> () - ) field_donor.a_fields; - | _ -> ()); - false - with Exit -> true - let link_dynamic a b = match follow a,follow b with | TMono r,TDynamic _ -> Monomorph.bind r b | TDynamic _,TMono r -> Monomorph.bind r a @@ -90,6 +299,13 @@ let fast_eq_check type_param_check a b = let rec fast_eq a b = fast_eq_check fast_eq a b +let fast_eq_pair (a,b) (a',b') = fast_eq a a' && fast_eq b b' + +let rec fast_eq_unbound_mono a b = + match a, b with + | TMono { tm_type = None }, TMono { tm_type = None } -> true + | _ -> fast_eq_check fast_eq_unbound_mono a b + let rec fast_eq_mono ml a b = if fast_eq_check (fast_eq_mono ml) a b then true @@ -131,7 +347,6 @@ let rec shallow_eq a b = | AbstractStatics a, AbstractStatics a2 -> a == a2 | Extend tl1, Extend tl2 -> fields_eq() && List.for_all2 shallow_eq tl1 tl2 | Closed, Closed -> fields_eq() - | Opened, Opened -> fields_eq() | Const, Const -> fields_eq() | _ -> false ) @@ -144,33 +359,12 @@ let rec shallow_eq a b = it's also the one that is pointed by the position. It's actually a typecheck of A :> B where some mutations can happen *) -type unify_error = - | Cannot_unify of t * t - | Invalid_field_type of string - | Has_no_field of t * string - | Has_no_runtime_field of t * string - | Has_extra_field of t * string - | Invalid_kind of string * field_kind * field_kind - | Invalid_visibility of string - | Not_matching_optional of string - | Cant_force_optional - | Invariant_parameter of int - | Constraint_failure of string - | Missing_overload of tclass_field * t - | FinalInvariance (* nice band name *) - | Invalid_function_argument of int (* index *) * int (* total *) - | Invalid_return_type - | Unify_custom of string - -exception Unify_error of unify_error list - let cannot_unify a b = Cannot_unify (a,b) let invalid_field n = Invalid_field_type n let invalid_kind n a b = Invalid_kind (n,a,b) let invalid_visibility n = Invalid_visibility n let has_no_field t n = Has_no_field (t,n) let has_extra_field t n = Has_extra_field (t,n) -let error l = raise (Unify_error l) (* we can restrict access as soon as both are runtime-compatible @@ -183,7 +377,7 @@ let unify_access a1 a2 = let direct_access = function | AccNo | AccNever | AccNormal | AccInline | AccRequire _ | AccCtor -> true - | AccResolve | AccCall -> false + | AccCall -> false let unify_kind k1 k2 = k1 = k2 || match k1, k2 with @@ -245,88 +439,78 @@ let rec_stack stack value fcheck frun ferror = let rec_stack_default stack value fcheck frun def = if not (rec_stack_exists fcheck stack) then rec_stack_loop stack value frun () else def -let rec_stack_bool stack value fcheck frun = - if (rec_stack_exists fcheck stack) then false else begin - try - stack.rec_stack <- value :: stack.rec_stack; - frun(); - stack.rec_stack <- List.tl stack.rec_stack; - true - with - Unify_error l -> - stack.rec_stack <- List.tl stack.rec_stack; - false - | e -> - stack.rec_stack <- List.tl stack.rec_stack; - raise e - end - -type eq_kind = - | EqStrict - | EqCoreType - | EqRightDynamic - | EqBothDynamic - | EqDoNotFollowNull (* like EqStrict, but does not follow Null *) - -let rec type_eq param a b = +let rec type_eq uctx a b = + let param = uctx.equality_kind in let can_follow t = match param with | EqCoreType -> false | EqDoNotFollowNull -> not (is_explicit_null t) | _ -> true in + let can_follow_abstract ab = uctx.equality_underlying && match ab.a_this with + | TAbstract (ab',_) -> ab' != ab + | _ -> true + in if a == b then () else match a , b with - | TLazy f , _ -> type_eq param (lazy_type f) b - | _ , TLazy f -> type_eq param a (lazy_type f) + | TLazy f , _ -> type_eq uctx (lazy_type f) b + | _ , TLazy f -> type_eq uctx a (lazy_type f) | TMono t , _ -> (match t.tm_type with | None -> if param = EqCoreType || not (link t a b) then error [cannot_unify a b] - | Some t -> type_eq param t b) + | Some t -> type_eq uctx t b) | _ , TMono t -> (match t.tm_type with | None -> if param = EqCoreType || not (link t b a) then error [cannot_unify a b] - | Some t -> type_eq param a t) + | Some t -> type_eq uctx a t) + | TDynamic a , TDynamic b -> + type_eq uctx a b + | _ , _ when a == t_dynamic && param = EqBothDynamic -> + () + | _ , _ when b == t_dynamic && (param = EqRightDynamic || param = EqBothDynamic) -> + () | TAbstract ({a_path=[],"Null"},[t1]),TAbstract ({a_path=[],"Null"},[t2]) -> - type_eq param t1 t2 + type_eq uctx t1 t2 | TAbstract ({a_path=[],"Null"},[t]),_ when param <> EqDoNotFollowNull -> - type_eq param t b + type_eq uctx t b | _,TAbstract ({a_path=[],"Null"},[t]) when param <> EqDoNotFollowNull -> - type_eq param a t + type_eq uctx a t | TType (t1,tl1), TType (t2,tl2) when (t1 == t2 || (param = EqCoreType && t1.t_path = t2.t_path)) && List.length tl1 = List.length tl2 -> - type_eq_params param a b tl1 tl2 + type_eq_params uctx a b tl1 tl2 | TType (t,tl) , _ when can_follow a -> - type_eq param (apply_params t.t_params tl t.t_type) b + rec_stack eq_stack (a,b) (fast_eq_pair (a,b)) + (fun() -> try_apply_params_rec t.t_params tl t.t_type (fun a -> type_eq uctx a b)) + (fun l -> error (cannot_unify a b :: l)) | _ , TType (t,tl) when can_follow b -> - rec_stack eq_stack (a,b) - (fun (a2,b2) -> fast_eq a a2 && fast_eq b b2) - (fun() -> type_eq param a (apply_params t.t_params tl t.t_type)) + rec_stack eq_stack (a,b) (fast_eq_pair (a,b)) + (fun() -> try_apply_params_rec t.t_params tl t.t_type (type_eq uctx a)) (fun l -> error (cannot_unify a b :: l)) | TEnum (e1,tl1) , TEnum (e2,tl2) -> if e1 != e2 && not (param = EqCoreType && e1.e_path = e2.e_path) then error [cannot_unify a b]; - type_eq_params param a b tl1 tl2 + type_eq_params uctx a b tl1 tl2 | TInst (c1,tl1) , TInst (c2,tl2) -> if c1 != c2 && not (param = EqCoreType && c1.cl_path = c2.cl_path) && (match c1.cl_kind, c2.cl_kind with KExpr _, KExpr _ -> false | _ -> true) then error [cannot_unify a b]; - type_eq_params param a b tl1 tl2 + type_eq_params uctx a b tl1 tl2 | TFun (l1,r1) , TFun (l2,r2) when List.length l1 = List.length l2 -> let i = ref 0 in (try - type_eq param r1 r2; + type_eq uctx r1 r2; List.iter2 (fun (n,o1,t1) (_,o2,t2) -> incr i; if o1 <> o2 then error [Not_matching_optional n]; - type_eq param t1 t2 + type_eq uctx t1 t2 ) l1 l2 with Unify_error l -> let msg = if !i = 0 then Invalid_return_type else Invalid_function_argument(!i,List.length l1) in error (cannot_unify a b :: msg :: l) ) - | TDynamic a , TDynamic b -> - type_eq param a b - | TAbstract (a1,tl1) , TAbstract (a2,tl2) -> - if a1 != a2 && not (param = EqCoreType && a1.a_path = a2.a_path) then error [cannot_unify a b]; - type_eq_params param a b tl1 tl2 + | TAbstract (a1,tl1) , TAbstract (a2,tl2) when a1 == a2 || (param = EqCoreType && a1.a_path = a2.a_path) -> + type_eq_params uctx a b tl1 tl2 + | TAbstract (ab,tl) , _ when can_follow_abstract ab -> + type_eq uctx (apply_params ab.a_params tl ab.a_this) b + | _ , TAbstract (ab,tl) when can_follow_abstract ab -> + type_eq uctx a (apply_params ab.a_params tl ab.a_this) | TAnon a1, TAnon a2 -> (try (match !(a2.a_status) with @@ -335,63 +519,54 @@ let rec type_eq param a b = | AbstractStatics a -> (match !(a1.a_status) with AbstractStatics a2 when a == a2 -> () | _ -> error []) | _ -> () ); - if would_produce_recursive_anon a1 a2 || would_produce_recursive_anon a2 a1 then error [cannot_unify a b]; PMap.iter (fun n f1 -> try let f2 = PMap.find n a2.a_fields in if f1.cf_kind <> f2.cf_kind && (param = EqStrict || param = EqCoreType || not (unify_kind f1.cf_kind f2.cf_kind)) then error [invalid_kind n f1.cf_kind f2.cf_kind]; let a = f1.cf_type and b = f2.cf_type in - (try type_eq param a b with Unify_error l -> error (invalid_field n :: l)); + (try type_eq uctx a b with Unify_error l -> error (invalid_field n :: l)); if (has_class_field_flag f1 CfPublic) != (has_class_field_flag f2 CfPublic) then error [invalid_visibility n]; with Not_found -> - if is_closed a2 then error [has_no_field b n]; - if not (link (Monomorph.create()) b f1.cf_type) then error [cannot_unify a b]; - a2.a_fields <- PMap.add n f1 a2.a_fields + error [has_no_field b n]; ) a1.a_fields; PMap.iter (fun n f2 -> if not (PMap.mem n a1.a_fields) then begin - if is_closed a1 then error [has_no_field a n]; - if not (link (Monomorph.create()) a f2.cf_type) then error [cannot_unify a b]; - a1.a_fields <- PMap.add n f2 a1.a_fields + error [has_no_field a n]; end; ) a2.a_fields; with Unify_error l -> error (cannot_unify a b :: l)) | _ , _ -> - if b == t_dynamic && (param = EqRightDynamic || param = EqBothDynamic) then - () - else if a == t_dynamic && param = EqBothDynamic then - () - else - error [cannot_unify a b] + error [cannot_unify a b] -and type_eq_params param a b tl1 tl2 = +and type_eq_params uctx a b tl1 tl2 = let i = ref 0 in List.iter2 (fun t1 t2 -> incr i; try - type_eq param t1 t2 + type_eq uctx t1 t2 with Unify_error l -> let err = cannot_unify a b in error (err :: (Invariant_parameter !i) :: l) ) tl1 tl2 -let type_iseq a b = +let type_iseq uctx a b = try - type_eq EqStrict a b; + type_eq uctx a b; true with Unify_error _ -> false let type_iseq_strict a b = try - type_eq EqDoNotFollowNull a b; + type_eq {default_unification_context with equality_kind = EqDoNotFollowNull} a b; true with Unify_error _ -> false let unify_stack = new_rec_stack() +let variance_stack = new_rec_stack() let abstract_cast_stack = new_rec_stack() let unify_new_monos = new_rec_stack() @@ -400,51 +575,53 @@ let print_stacks() = let st = s_type ctx in print_endline "unify_stack"; List.iter (fun (a,b) -> Printf.printf "\t%s , %s\n" (st a) (st b)) unify_stack.rec_stack; + print_endline "variance_stack"; + List.iter (fun (a,b) -> Printf.printf "\t%s , %s\n" (st a) (st b)) variance_stack.rec_stack; print_endline "monos"; List.iter (fun m -> print_endline ("\t" ^ st m)) unify_new_monos.rec_stack; print_endline "abstract_cast_stack"; List.iter (fun (a,b) -> Printf.printf "\t%s , %s\n" (st a) (st b)) abstract_cast_stack.rec_stack -let rec unify a b = +let rec unify (uctx : unification_context) a b = if a == b then () else match a, b with - | TLazy f , _ -> unify (lazy_type f) b - | _ , TLazy f -> unify a (lazy_type f) + | TLazy f , _ -> unify uctx (lazy_type f) b + | _ , TLazy f -> unify uctx a (lazy_type f) | TMono t , _ -> (match t.tm_type with | None -> if not (link t a b) then error [cannot_unify a b] - | Some t -> unify t b) + | Some t -> unify uctx t b) | _ , TMono t -> (match t.tm_type with | None -> if not (link t b a) then error [cannot_unify a b] - | Some t -> unify a t) + | Some t -> unify uctx a t) | TType (t,tl) , _ -> rec_stack unify_stack (a,b) - (fun(a2,b2) -> fast_eq a a2 && fast_eq b b2) - (fun() -> try_apply_params_rec t.t_params tl t.t_type (fun a -> unify a b)) + (fun(a2,b2) -> fast_eq_unbound_mono a a2 && fast_eq b b2) + (fun() -> try_apply_params_rec t.t_params tl t.t_type (fun a -> unify uctx a b)) (fun l -> error (cannot_unify a b :: l)) | _ , TType (t,tl) -> rec_stack unify_stack (a,b) - (fun(a2,b2) -> fast_eq a a2 && fast_eq b b2) - (fun() -> try_apply_params_rec t.t_params tl t.t_type (unify a)) + (fun(a2,b2) -> fast_eq a a2 && fast_eq_unbound_mono b b2) + (fun() -> try_apply_params_rec t.t_params tl t.t_type (unify uctx a)) (fun l -> error (cannot_unify a b :: l)) | TEnum (ea,tl1) , TEnum (eb,tl2) -> if ea != eb then error [cannot_unify a b]; - unify_type_params a b tl1 tl2 + unify_type_params uctx a b tl1 tl2 | TAbstract ({a_path=[],"Null"},[t]),_ -> - begin try unify t b + begin try unify uctx t b with Unify_error l -> error (cannot_unify a b :: l) end | _,TAbstract ({a_path=[],"Null"},[t]) -> - begin try unify a t + begin try unify uctx a t with Unify_error l -> error (cannot_unify a b :: l) end | TAbstract (a1,tl1) , TAbstract (a2,tl2) when a1 == a2 -> begin try - unify_type_params a b tl1 tl2 + unify_type_params uctx a b tl1 tl2 with Unify_error _ as err -> (* the type could still have a from/to relation to itself (issue #3494) *) begin try - unify_abstracts a b a1 tl1 a2 tl2 + unify_abstracts uctx a b a1 tl1 a2 tl2 with Unify_error _ -> raise err end @@ -455,12 +632,14 @@ let rec unify a b = | TAbstract ({ a_path = ["haxe"],"NotVoid" },[]), _ | _, TAbstract ({ a_path = ["haxe"],"NotVoid" },[]) -> () + | TAbstract (ab,tl), TAbstract ({ a_path = ["haxe"],("FlatEnum" | "Function" | "Constructible") },_) -> + unify_to {uctx with allow_transitive_cast = false} a b ab tl | TAbstract (a1,tl1) , TAbstract (a2,tl2) -> - unify_abstracts a b a1 tl1 a2 tl2 + unify_abstracts uctx a b a1 tl1 a2 tl2 | TInst (c1,tl1) , TInst (c2,tl2) -> let rec loop c tl = if c == c2 then begin - unify_type_params a b tl tl2; + unify_type_params uctx a b tl tl2; true end else (match c.cl_super with | None -> false @@ -473,21 +652,22 @@ let rec unify a b = | KTypeParameter pl -> List.exists (fun t -> match follow t with | TInst (cs,tls) -> loop cs (List.map (apply_params c.cl_params tl) tls) - | TAbstract(aa,tl) -> List.exists (unify_to aa tl b) aa.a_to + | TAbstract(aa,tl) -> unifies_to uctx a b aa tl | _ -> false ) pl | _ -> false) in if not (loop c1 tl1) then error [cannot_unify a b] | TFun (l1,r1) , TFun (l2,r2) when List.length l1 = List.length l2 -> + let uctx = get_nested_context uctx in let i = ref 0 in (try (match follow r2 with | TAbstract ({a_path=[],"Void"},_) -> incr i - | _ -> unify r1 r2; incr i); + | _ -> unify uctx r1 r2; incr i); List.iter2 (fun (_,o1,t1) (_,o2,t2) -> if o1 && not o2 then error [Cant_force_optional]; - unify t1 t2; + unify uctx t1 t2; incr i ) l2 l1 (* contravariance *) with @@ -500,6 +680,7 @@ let rec unify a b = (* one of the constraints must unify with { } *) if not (List.exists (fun t -> match follow t with TInst _ | TAnon _ -> true | _ -> false) pl) then error [cannot_unify a b] | _ -> ()); + ignore(c.cl_build()); (try PMap.iter (fun n f2 -> (* @@ -527,7 +708,7 @@ let rec unify a b = 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 f1 ft f2 with e -> unify_new_monos.rec_stack <- old_monos; raise e) + (fun() -> try unify_with_access uctx f1 ft f2 with e -> unify_new_monos.rec_stack <- old_monos; raise e) (fun l -> error (invalid_field n :: l)); unify_new_monos.rec_stack <- old_monos; | Method MethNormal | Method MethInline | Var { v_write = AccNo } | Var { v_write = AccNever } -> @@ -536,19 +717,19 @@ let rec unify a b = 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 f1 ft f2 with e -> unify_new_monos.rec_stack <- old_monos; raise e) + (fun() -> try unify_with_access uctx f1 ft f2 with e -> unify_new_monos.rec_stack <- old_monos; raise e) (fun l -> error (invalid_field n :: l)); unify_new_monos.rec_stack <- old_monos; | _ -> (* will use fast_eq, which have its own stack *) try - unify_with_access f1 ft f2 + unify_with_access uctx f1 ft f2 with Unify_error l -> error (invalid_field n :: l)); List.iter (fun f2o -> - if not (List.exists (fun f1o -> type_iseq f1o.cf_type f2o.cf_type) (f1 :: f1.cf_overloads)) + if not (List.exists (fun f1o -> type_iseq uctx f1o.cf_type f2o.cf_type) (f1 :: f1.cf_overloads)) then error [Missing_overload (f1, f2o.cf_type)] ) f2.cf_overloads; (* we mark the field as :?used because it might be used through the structure *) @@ -570,24 +751,23 @@ let rec unify a b = end; (match f1.cf_kind with | Method MethInline -> - if (c.cl_extern || has_class_field_flag f1 CfExtern) && not (Meta.has Meta.Runtime f1.cf_meta) then error [Has_no_runtime_field (a,n)]; + if ((has_class_flag c CExtern) || has_class_field_flag f1 CfExtern) && not (Meta.has Meta.Runtime f1.cf_meta) then error [Has_no_runtime_field (a,n)]; | _ -> ()); ) an.a_fields; (match !(an.a_status) with - | Opened -> an.a_status := Closed; | Statics _ | EnumStatics _ | AbstractStatics _ -> error [] | Closed | Extend _ | Const -> ()) with Unify_error l -> error (cannot_unify a b :: l)) | TAnon a1, TAnon a2 -> - unify_anons a b a1 a2 + unify_anons uctx a b a1 a2 | TAnon an, TAbstract ({ a_path = [],"Class" },[pt]) -> (match !(an.a_status) with - | Statics cl -> unify (TInst (cl,List.map (fun _ -> mk_mono()) cl.cl_params)) pt + | Statics cl -> unify uctx (TInst (cl,List.map (fun _ -> mk_mono()) cl.cl_params)) pt | _ -> error [cannot_unify a b]) | TAnon an, TAbstract ({ a_path = [],"Enum" },[pt]) -> (match !(an.a_status) with - | EnumStatics e -> unify (TEnum (e,List.map (fun _ -> mk_mono()) e.e_params)) pt + | EnumStatics e -> unify uctx (TEnum (e,List.map (fun _ -> mk_mono()) e.e_params)) pt | _ -> error [cannot_unify a b]) | TEnum _, TAbstract ({ a_path = [],"EnumValue" },[]) -> () @@ -600,28 +780,28 @@ let rec unify a b = begin match c.cl_kind with | KTypeParameter tl -> (* type parameters require an equal Constructible constraint *) - if not (List.exists (fun t -> match follow t with TAbstract({a_path = ["haxe"],"Constructible"},[t2]) -> type_iseq t1 t2 | _ -> false) tl) then error [cannot_unify a b] + if not (List.exists (fun t -> match follow t with TAbstract({a_path = ["haxe"],"Constructible"},[t2]) -> type_iseq uctx t1 t2 | _ -> false) tl) then error [cannot_unify a b] | _ -> let _,t,cf = class_field c tl "new" in if not (has_class_field_flag cf CfPublic) then error [invalid_visibility "new"]; - begin try unify t t1 + begin try unify uctx t t1 with Unify_error l -> error (cannot_unify a b :: l) end end with Not_found -> error [has_no_field a "new"] end | TDynamic t , _ -> - if t == a then + if t == a && uctx.allow_dynamic_to_cast then () else (match b with | TDynamic t2 -> if t2 != b then (try - type_eq EqRightDynamic t t2 + type_eq {uctx with equality_kind = EqRightDynamic} t t2 with Unify_error l -> error (cannot_unify a b :: l)); - | TAbstract(bb,tl) when (List.exists (unify_from bb tl a b) bb.a_from) -> - () + | TAbstract(bb,tl) -> + unify_from uctx a b bb tl | _ -> error [cannot_unify a b]) | _ , TDynamic t -> @@ -631,69 +811,53 @@ let rec unify a b = | TDynamic t2 -> if t2 != a then (try - type_eq EqRightDynamic t t2 + type_eq {uctx with equality_kind = EqRightDynamic} t t2 with Unify_error l -> error (cannot_unify a b :: l)); | TAnon an -> (try (match !(an.a_status) with | Statics _ | EnumStatics _ -> error [] - | Opened -> an.a_status := Closed | _ -> ()); PMap.iter (fun _ f -> try - type_eq EqStrict (field_type f) t + type_eq uctx (field_type f) t with Unify_error l -> error (invalid_field f.cf_name :: l) ) an.a_fields with Unify_error l -> error (cannot_unify a b :: l)) - | TAbstract(aa,tl) when (List.exists (unify_to aa tl b) aa.a_to) -> - () + | TAbstract(aa,tl) -> + unify_to uctx a b aa tl | _ -> error [cannot_unify a b]) | TAbstract (aa,tl), _ -> - if not (List.exists (unify_to aa tl b) aa.a_to) then error [cannot_unify a b]; + unify_to uctx a b aa tl | TInst ({ cl_kind = KTypeParameter ctl } as c,pl), TAbstract (bb,tl) -> (* one of the constraints must satisfy the abstract *) if not (List.exists (fun t -> let t = apply_params c.cl_params pl t in - try unify t b; true with Unify_error _ -> false - ) ctl) && not (List.exists (unify_from bb tl a b) bb.a_from) then error [cannot_unify a b]; + try unify uctx t b; true with Unify_error _ -> false + ) ctl) then unify_from uctx a b bb tl | _, TAbstract (bb,tl) -> - if not (List.exists (unify_from bb tl a b) bb.a_from) then error [cannot_unify a b] + unify_from uctx a b bb tl | _ , _ -> error [cannot_unify a b] -and unify_abstracts a b a1 tl1 a2 tl2 = - let f1 = unify_to a1 tl1 b in - let f2 = unify_from a2 tl2 a b in - if (List.exists (f1 ~allow_transitive_cast:false) a1.a_to) - || (List.exists (f2 ~allow_transitive_cast:false) a2.a_from) - || (((Meta.has Meta.CoreType a1.a_meta) || (Meta.has Meta.CoreType a2.a_meta)) - && ((List.exists f1 a1.a_to) || (List.exists f2 a2.a_from))) then - () - else - error [cannot_unify a b] - -and unify_anons a b a1 a2 = - if would_produce_recursive_anon a1 a2 then error [cannot_unify a b]; +and unify_anons uctx a b a1 a2 = (try PMap.iter (fun n f2 -> try let f1 = PMap.find n a1.a_fields in if not (unify_kind f1.cf_kind f2.cf_kind) then - (match !(a1.a_status), f1.cf_kind, f2.cf_kind with - | Opened, Var { v_read = AccNormal; v_write = AccNo }, Var { v_read = AccNormal; v_write = AccNormal } -> - f1.cf_kind <- f2.cf_kind; - | _ -> error [invalid_kind n f1.cf_kind f2.cf_kind]); + error [invalid_kind n f1.cf_kind f2.cf_kind]; if (has_class_field_flag f2 CfPublic) && not (has_class_field_flag f1 CfPublic) then error [invalid_visibility n]; try let f1_type = if fast_eq f1.cf_type f2.cf_type then f1.cf_type else field_type f1 in - unify_with_access f1 f1_type f2; + unify_with_access uctx f1 f1_type f2; (match !(a1.a_status) with | Statics c when not (Meta.has Meta.MaybeUsed f1.cf_meta) -> f1.cf_meta <- (Meta.MaybeUsed,[],f1.cf_pos) :: f1.cf_meta | _ -> ()); @@ -702,152 +866,280 @@ and unify_anons a b a1 a2 = with Not_found -> match !(a1.a_status) with - | Opened -> - if not (link (Monomorph.create()) a f2.cf_type) then error []; - a1.a_fields <- PMap.add n f2 a1.a_fields | Const when Meta.has Meta.Optional f2.cf_meta -> () | _ -> error [has_no_field a n]; ) a2.a_fields; - (match !(a1.a_status) with - | Const when not (PMap.is_empty a2.a_fields) -> - PMap.iter (fun n _ -> if not (PMap.mem n a2.a_fields) then error [has_extra_field a n]) a1.a_fields; - | Opened -> - a1.a_status := Closed - | _ -> ()); (match !(a2.a_status) with | Statics c -> (match !(a1.a_status) with Statics c2 when c == c2 -> () | _ -> error []) | EnumStatics e -> (match !(a1.a_status) with EnumStatics e2 when e == e2 -> () | _ -> error []) | AbstractStatics a -> (match !(a1.a_status) with AbstractStatics a2 when a == a2 -> () | _ -> error []) - | Opened -> a2.a_status := Closed | Const | Extend _ | Closed -> ()) with Unify_error l -> error (cannot_unify a b :: l)) -and unify_from ab tl a b ?(allow_transitive_cast=true) t = - rec_stack_bool abstract_cast_stack (a,b) - (fun (a2,b2) -> fast_eq a a2 && fast_eq b b2) - (fun() -> - let t = apply_params ab.a_params tl t in - let unify_func = if allow_transitive_cast then unify else type_eq EqRightDynamic in - unify_func a t) - -and unify_to ab tl b ?(allow_transitive_cast=true) t = - let t = apply_params ab.a_params tl t in - let unify_func = if allow_transitive_cast then unify else type_eq EqStrict in - try - unify_func t b; - true - with Unify_error _ -> - false +and does_func_unify f = + try f(); true with Unify_error _ -> false -and unify_from_field ab tl a b ?(allow_transitive_cast=true) (t,cf) = - rec_stack_bool abstract_cast_stack (a,b) - (fun (a2,b2) -> fast_eq a a2 && fast_eq b b2) - (fun() -> - let unify_func = if allow_transitive_cast then unify else type_eq EqStrict in - match follow cf.cf_type with - | TFun(_,r) -> - let monos = List.map (fun _ -> mk_mono()) cf.cf_params in - let map t = apply_params ab.a_params tl (apply_params cf.cf_params monos t) in - unify_func a (map t); - List.iter2 (fun m (name,t) -> match follow t with - | TInst ({ cl_kind = KTypeParameter constr },_) when constr <> [] -> - List.iter (fun tc -> match follow m with TMono _ -> raise (Unify_error []) | _ -> unify m (map tc) ) constr - | _ -> () - ) monos cf.cf_params; - unify_func (map r) b; - true - | _ -> die "" __LOC__) - -and unify_to_field ab tl b ?(allow_transitive_cast=true) (t,cf) = - let a = TAbstract(ab,tl) in - rec_stack_bool abstract_cast_stack (b,a) - (fun (b2,a2) -> fast_eq a a2 && fast_eq b b2) - (fun() -> - let unify_func = if allow_transitive_cast then unify else type_eq EqStrict in - match follow cf.cf_type with - | TFun((_,_,ta) :: _,_) -> - let monos = List.map (fun _ -> mk_mono()) cf.cf_params in - let map t = apply_params ab.a_params tl (apply_params cf.cf_params monos t) in - let athis = map ab.a_this in - (* we cannot allow implicit casts when the this type is not completely known yet *) - (* if has_mono athis then raise (Unify_error []); *) - with_variance (type_eq EqStrict) athis (map ta); - (* immediate constraints checking is ok here because we know there are no monomorphs *) - List.iter2 (fun m (name,t) -> match follow t with - | TInst ({ cl_kind = KTypeParameter constr },_) when constr <> [] -> - List.iter (fun tc -> match follow m with TMono _ -> raise (Unify_error []) | _ -> unify m (map tc) ) constr - | _ -> () - ) monos cf.cf_params; - unify_func (map t) b; - | _ -> die "" __LOC__) +and does_func_unify_arg f arg = + try f arg; true with Unify_error _ -> false + +and get_abstract_context uctx a b ab = + if (Meta.has Meta.CoreType ab.a_meta) || (Meta.has Meta.Transitive ab.a_meta) then + uctx + else if uctx.allow_abstract_cast then + {uctx with allow_abstract_cast = false} + else + error [cannot_unify a b] + +and get_nested_context uctx = + {uctx with allow_abstract_cast = true} + +and unifies_with_abstract uctx a b f = + rec_stack_default abstract_cast_stack (a,b) (fast_eq_pair (a,b)) (fun() -> + (uctx.allow_transitive_cast && f {uctx with allow_transitive_cast = false}) || f uctx + ) false + +and get_abstract_unify_func uctx equality_kind = + if uctx.allow_transitive_cast then unify uctx else type_eq {uctx with equality_kind = equality_kind} + +and unify_abstracts uctx a b a1 tl1 a2 tl2 = + if not (unifies_abstracts uctx a b a1 tl1 a2 tl2) then error [cannot_unify a b] + +and unify_from uctx a b ab tl = + if not (unifies_from uctx a b ab tl) then error [cannot_unify a b] + +and unify_to uctx a b ab tl = + if not (unifies_to uctx a b ab tl) then error [cannot_unify a b] + +and unifies_abstracts uctx a b a1 tl1 a2 tl2 = + unifies_with_abstract uctx a b (fun uctx -> + List.exists (unifies_to_direct uctx a b a1 tl1) a1.a_to || + List.exists (unifies_from_direct uctx a b a2 tl2) a2.a_from + ) + +and unifies_from uctx a b ab tl = + unifies_with_abstract uctx a b (fun uctx -> + List.exists (unifies_from_direct uctx a b ab tl) ab.a_from + ) -and unify_with_variance f t1 t2 = - let allows_variance_to t tf = type_iseq tf t in - match follow t1,follow t2 with +and unifies_to uctx a b ab tl = + unifies_with_abstract uctx a b (fun uctx -> + List.exists (unifies_to_direct uctx a b ab tl) ab.a_to + ) + +and unifies_from_direct uctx a b ab tl t = + does_func_unify (fun() -> + let t = apply_params ab.a_params tl t in + let uctx = get_abstract_context uctx a b ab in + let unify_func = get_abstract_unify_func uctx EqRightDynamic in + unify_func a t) + +and unifies_to_direct uctx a b ab tl t = + does_func_unify (fun() -> + let t = apply_params ab.a_params tl t in + let uctx = get_abstract_context uctx a b ab in + let unify_func = get_abstract_unify_func uctx EqStrict in + unify_func t b) + +and unifies_from_field uctx a b ab tl (t,cf) = + does_func_unify (fun() -> + match follow cf.cf_type with + | TFun(_,r) -> + let map = apply_params ab.a_params tl in + let monos = Monomorph.spawn_constrained_monos map cf.cf_params in + let map t = map (apply_params cf.cf_params monos t) in + let uctx = get_abstract_context uctx a b ab in + let unify_func = get_abstract_unify_func uctx EqStrict in + unify_func a (map t); + unify_func (map r) b; + | _ -> die "" __LOC__) + +and unifies_to_field uctx a b ab tl (t,cf) = + does_func_unify (fun() -> + match follow cf.cf_type with + | TFun((_,_,ta) :: _,_) -> + let map = apply_params ab.a_params tl in + let monos = Monomorph.spawn_constrained_monos map cf.cf_params in + let map t = map (apply_params cf.cf_params monos t) in + let uctx = get_abstract_context uctx a b ab in + let unify_func = get_abstract_unify_func uctx EqStrict in + let athis = map ab.a_this in + (* we cannot allow implicit casts when the this type is not completely known yet *) + with_variance uctx (type_eq {uctx with equality_kind = EqStrict}) athis (map ta); + unify_func (map t) b; + | _ -> die "" __LOC__) + +and unify_with_variance uctx f t1 t2 = + let t1 = follow_without_type t1 in + let t2 = follow_without_type t2 in + let fail () = error [cannot_unify t1 t2] in + let unify_rec f = rec_stack variance_stack (t1,t2) (fast_eq_pair (t1,t2)) f (fun _ -> fail()) in + let unify_nested t1 t2 = with_variance (get_nested_context uctx) f t1 t2 in + let unify_tls tl1 tl2 = List.iter2 unify_nested tl1 tl2 in + let get_this_type ab tl = follow_without_type (apply_params ab.a_params tl ab.a_this) in + let get_defined_type td tl = follow_without_type (apply_params td.t_params tl td.t_type) in + let compare_underlying () = type_eq {uctx with equality_underlying = true; equality_kind = EqBothDynamic} t1 t2 in + let unifies_abstract uctx a b ab tl ats = + try + let uctx = get_abstract_context uctx a b ab in + rec_stack_default abstract_cast_stack (a,b) (fast_eq_pair (a,b)) (fun() -> + List.exists (does_func_unify_arg (fun at -> + let at = apply_params ab.a_params tl at in + if ats == ab.a_to then + with_variance uctx f at b + else + with_variance uctx f a at + )) ats + ) false + with Unify_error _ -> false + in + match t1,t2 with | TInst(c1,tl1),TInst(c2,tl2) when c1 == c2 -> - List.iter2 f tl1 tl2 + unify_tls tl1 tl2 | TEnum(en1,tl1),TEnum(en2,tl2) when en1 == en2 -> - List.iter2 f tl1 tl2 - | TAbstract(a1,tl1),TAbstract(a2,tl2) when a1 == a2 && Meta.has Meta.CoreType a1.a_meta -> - List.iter2 f tl1 tl2 - | TAbstract(a1,pl1),TAbstract(a2,pl2) -> - if (Meta.has Meta.CoreType a1.a_meta) && (Meta.has Meta.CoreType a2.a_meta) then begin - let ta1 = apply_params a1.a_params pl1 a1.a_this in - let ta2 = apply_params a2.a_params pl2 a2.a_this in - type_eq EqStrict ta1 ta2; - end; - if not (List.exists (allows_variance_to t2) a1.a_to) && not (List.exists (allows_variance_to t1) a2.a_from) then - error [cannot_unify t1 t2] - | TAbstract(a,pl),t -> - type_eq EqBothDynamic (apply_params a.a_params pl a.a_this) t; - if not (List.exists (fun t2 -> allows_variance_to t (apply_params a.a_params pl t2)) a.a_to) then error [cannot_unify t1 t2] - | t,TAbstract(a,pl) -> - type_eq EqBothDynamic t (apply_params a.a_params pl a.a_this); - if not (List.exists (fun t2 -> allows_variance_to t (apply_params a.a_params pl t2)) a.a_from) then error [cannot_unify t1 t2] - | (TAnon a1 as t1), (TAnon a2 as t2) -> - rec_stack unify_stack (t1,t2) - (fun (a,b) -> fast_eq a t1 && fast_eq b t2) - (fun() -> unify_anons t1 t2 a1 a2) - (fun l -> error l) + unify_tls tl1 tl2 + | TAbstract(a1,tl1),TAbstract(a2,tl2) when a1 == a2 -> + unify_tls tl1 tl2 + | TType(td1,tl1),TType(td2,tl2) when td1 == td2 -> + unify_tls tl1 tl2 + | TType(td,tl),_ -> + unify_rec (fun() -> unify_with_variance uctx f (get_defined_type td tl) t2) + | _,TType(td,tl) -> + unify_rec (fun() -> unify_with_variance uctx f t1 (get_defined_type td tl)) + | TAbstract(ab,tl),_ when Meta.has Meta.ForwardVariance ab.a_meta -> + with_variance uctx f (get_this_type ab tl) t2 + | _,TAbstract(ab,tl) when Meta.has Meta.ForwardVariance ab.a_meta -> + with_variance uctx f t1 (get_this_type ab tl) + | TAbstract(a1,tl1),TAbstract(a2,tl2) -> + if not (unifies_abstract uctx t1 t2 a1 tl1 a1.a_to) + && not (unifies_abstract uctx t1 t2 a2 tl2 a2.a_from) then fail(); + compare_underlying(); + | TAbstract(ab,tl),_ -> + if not (unifies_abstract uctx t1 t2 ab tl ab.a_to) then fail(); + compare_underlying(); + | _,TAbstract(ab,tl) -> + if not (unifies_abstract uctx t1 t2 ab tl ab.a_from) then fail(); + compare_underlying(); + | TAnon(a1),TAnon(a2) -> + unify_anons uctx t1 t2 a1 a2 + | TFun(al1,r1),TFun(al2,r2) when List.length al1 = List.length al2 -> + List.iter2 (fun (_,_,t1) (_,_,t2) -> unify_nested t1 t2) al1 al2; + unify_nested r1 r2; | _ -> - error [cannot_unify t1 t2] + fail() -and unify_type_params a b tl1 tl2 = +and unify_type_params uctx a b tl1 tl2 = + let uctx = get_nested_context uctx in let i = ref 0 in List.iter2 (fun t1 t2 -> incr i; try - with_variance (type_eq EqRightDynamic) t1 t2 + with_variance uctx (type_eq {uctx with equality_kind = EqRightDynamic}) t1 t2 with Unify_error l -> let err = cannot_unify a b in error (err :: (Invariant_parameter !i) :: l) ) tl1 tl2 -and with_variance f t1 t2 = +and with_variance uctx f t1 t2 = try f t1 t2 with Unify_error l -> try - unify_with_variance (with_variance f) t1 t2 + unify_with_variance uctx f t1 t2 with Unify_error _ -> raise (Unify_error l) -and unify_with_access f1 t1 f2 = +and unify_with_access uctx f1 t1 f2 = + let uctx = get_nested_context uctx in match f2.cf_kind with (* write only *) - | Var { v_read = AccNo } | Var { v_read = AccNever } -> unify f2.cf_type t1 + | Var { v_read = AccNo } | Var { v_read = AccNever } -> unify uctx f2.cf_type t1 (* read only *) | Method MethNormal | Method MethInline | Var { v_write = AccNo } | Var { v_write = AccNever } -> if (has_class_field_flag f1 CfFinal) <> (has_class_field_flag f2 CfFinal) then raise (Unify_error [FinalInvariance]); - unify t1 f2.cf_type + unify uctx t1 f2.cf_type (* read/write *) - | _ -> with_variance (type_eq EqBothDynamic) t1 f2.cf_type + | _ -> with_variance uctx (type_eq {uctx with equality_kind = EqBothDynamic}) t1 f2.cf_type let does_unify a b = try - unify a b; + unify default_unification_context a b; true with Unify_error _ -> false + +let unify_custom = unify +let unify = unify default_unification_context + +let type_eq_custom = type_eq +let type_eq param = type_eq {default_unification_context with equality_kind = param} + +let type_iseq_custom = type_iseq +let type_iseq = type_iseq default_unification_context + +module UnifyMinT = struct + let collect_base_types t = + let tl = ref [] in + let rec loop t = (match t with + | TInst(cl, params) -> + (match cl.cl_kind with + | KTypeParameter tl -> List.iter loop tl + | _ -> ()); + List.iter (fun (ic, ip) -> + let t = apply_params cl.cl_params params (TInst (ic,ip)) in + loop t + ) cl.cl_implements; + (match cl.cl_super with None -> () | Some (csup, pl) -> + let t = apply_params cl.cl_params params (TInst (csup,pl)) in + loop t); + tl := t :: !tl; + | TType (td,pl) -> + loop (apply_params td.t_params pl td.t_type); + (* prioritize the most generic definition *) + tl := t :: !tl; + | TLazy f -> loop (lazy_type f) + | TMono r -> (match r.tm_type with None -> () | Some t -> loop t) + | _ -> tl := t :: !tl) + in + loop t; + !tl + + let unify_min' uctx common_types tl = + let first_error = ref None in + let rec loop index common_types tl = match tl with + | [] -> + begin match common_types with + | [] -> + begin match !first_error with + | None -> die "" __LOC__ + | Some(l,p) -> UnifyMinError(l,p) + end + | hd :: _ -> + UnifyMinOk hd + end + | t :: tl -> + let common_types = List.filter (fun t' -> + try + unify_custom uctx t t'; + true + with Unify_error l -> + if !first_error = None then first_error := Some(l,index); + false + ) common_types in + loop (index + 1) common_types tl + in + loop 0 common_types tl + + let unify_min uctx t0 tl = + match tl with + | [] -> + UnifyMinOk t0 + | _ -> + let common_types = collect_base_types t0 in + unify_min' uctx common_types tl +end +;; +unify_ref := unify_custom;; +unify_min_ref := UnifyMinT.unify_min;; +monomorph_classify_constraints_ref := Monomorph.classify_constraints diff --git a/src/core/texpr.ml b/src/core/texpr.ml index ffa9937a..6bf0c475 100644 --- a/src/core/texpr.ml +++ b/src/core/texpr.ml @@ -593,6 +593,9 @@ let rec type_constant_value basic (e,p) = | _ -> error "Constant value expected" p +let is_constant_value basic e = + try (ignore (type_constant_value basic e); true) with Error (Custom _,_) -> false + let for_remap basic v e1 e2 p = let v' = alloc_var v.v_kind v.v_name e1.etype e1.epos in let ev' = mk (TLocal v') e1.etype e1.epos in @@ -766,8 +769,8 @@ let collect_captured_vars e = let accesses_this = ref false in let declare v = Hashtbl.add known v.v_id () in let rec loop e = match e.eexpr with - | TLocal ({v_capture = true; v_id = id} as v) when not (Hashtbl.mem known id) -> - Hashtbl.add known id (); + | TLocal v when has_var_flag v VCaptured && not (Hashtbl.mem known v.v_id) -> + Hashtbl.add known v.v_id (); unknown := v :: !unknown | TConst (TThis | TSuper) -> accesses_this := true; diff --git a/src/core/timer.ml b/src/core/timer.ml index 7335cfc3..aeb3e3f2 100644 --- a/src/core/timer.ml +++ b/src/core/timer.ml @@ -190,4 +190,24 @@ let report_times print = in List.iter (loop 0) root.children; print sep; - print_time "total" root \ No newline at end of file + 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 \ No newline at end of file diff --git a/src/core/withType.ml b/src/core/withType.ml index 99d1e32f..6f42b3d4 100644 --- a/src/core/withType.ml +++ b/src/core/withType.ml @@ -1,8 +1,13 @@ open Type +type with_type_source_information = { + si_name : string; + si_doc : string option; +} + type with_type_source = - | FunctionArgument of string - | StructureField of string + | FunctionArgument of with_type_source_information + | StructureField of with_type_source_information | ImplicitReturn type t = @@ -10,22 +15,28 @@ type t = | Value of with_type_source option | WithType of Type.t * with_type_source option +let make_with_type_source_information name doc = { + si_name = name; + si_doc = doc; +} + let with_type t = WithType(t,None) let of_implicit_return t = WithType(t,Some ImplicitReturn) -let with_argument t name = WithType(t,Some(FunctionArgument name)) -let with_structure_field t name = WithType(t,Some(StructureField name)) +let with_argument t name = WithType(t,Some(FunctionArgument (make_with_type_source_information name None))) +let with_argument_and_doc t name doc = WithType(t,Some(FunctionArgument (make_with_type_source_information name (Some doc)))) +let with_structure_field t name = WithType(t,Some(StructureField (make_with_type_source_information name None))) let value = Value None -let named_argument name = Value (Some(FunctionArgument name)) -let named_structure_field name = Value (Some(StructureField name)) +let named_argument name = Value (Some(FunctionArgument (make_with_type_source_information name None))) +let named_structure_field name = Value (Some(StructureField (make_with_type_source_information name None))) let no_value = NoValue let to_string = function | NoValue -> "NoValue" | Value (None | Some ImplicitReturn) -> "Value" - | Value (Some(FunctionArgument s | StructureField s)) -> "Value " ^ s + | Value (Some(FunctionArgument si | StructureField si)) -> "Value " ^ si.si_name | WithType(t,s) -> let name = match s with - | Some(FunctionArgument s | StructureField s) -> s + | Some(FunctionArgument si | StructureField si) -> si.si_name | _ -> "None" in Printf.sprintf "WithType(%s, %s)" (s_type (print_context()) t) name diff --git a/src/dune b/src/dune index dcb3496c..b88ba872 100644 --- a/src/dune +++ b/src/dune @@ -2,7 +2,7 @@ (env (_ - (flags (:standard -w -3 -thread)) + (flags (:standard -w -3 -w -23 -thread)) ) ) @@ -13,6 +13,7 @@ json unix str threads dynlink xml-light extlib ptmap sha + luv ) (modules (:standard \ haxe)) (preprocess (per_module diff --git a/src/filters/ES6Ctors.ml b/src/filters/ES6Ctors.ml index 38e9c23b..9ba083d7 100644 --- a/src/filters/ES6Ctors.ml +++ b/src/filters/ES6Ctors.ml @@ -83,7 +83,7 @@ let rewrite_ctors com = let mark_does_ctor_skipping cl cl_super p_this_access = let rec mark_needs_ctor_skipping cl = (* for non haxe-generated extern classes we can't generate any valid code, so just fail *) - if cl.cl_extern && not (Meta.has Meta.HxGen cl.cl_meta) then begin + if (has_class_flag cl CExtern) && not (Meta.has Meta.HxGen cl.cl_meta) then begin abort "Must call `super()` constructor before accessing `this` in classes derived from an extern class with constructor" p_this_access; end; try diff --git a/src/filters/capturedVars.ml b/src/filters/capturedVars.ml index 890e359d..d94ac205 100644 --- a/src/filters/capturedVars.ml +++ b/src/filters/capturedVars.ml @@ -128,8 +128,8 @@ let captured_vars com e = let tmp_used = ref used in let rec browse = function | Block f | Loop f | Function f -> f browse - | Use ({ v_extra = Some( _ :: _, _) }) - | Assign ({ v_extra = Some( _ :: _, _) }) when com.platform = Cs || (com.platform = Java && not (Common.defined com Define.Jvm)) -> + | Use ({ v_extra = Some({v_params = _ :: _}) }) + | Assign ({ v_extra = Some({v_params = _ :: _}) }) when com.platform = Cs || (com.platform = Java && not (Common.defined com Define.Jvm)) -> (* Java and C# deal with functions with type parameters in a different way *) (* so they do should not be wrapped *) () @@ -163,7 +163,7 @@ let captured_vars com e = | TLocal v -> begin try let v' = List.assoc v.v_id new_vars in - v'.v_capture <- true; + add_var_flag v' VCaptured; {e with eexpr = TLocal v'} with Not_found -> e @@ -192,7 +192,7 @@ let captured_vars com e = let used = PMap.map (fun v -> let vt = v.v_type in v.v_type <- impl#captured_type vt; - v.v_capture <- true; + add_var_flag v VCaptured; vt ) used in wrap used e @@ -219,8 +219,8 @@ let captured_vars com e = incr depth; f (collect_vars false); decr depth; - | Use ({ v_extra = Some( _ :: _, _) }) - | Assign ({ v_extra = Some( _ :: _, _) }) when com.platform = Cs || (com.platform = Java && not (Common.defined com Define.Jvm)) -> + | Use ({ v_extra = Some({v_params = _ :: _}) }) + | Assign ({ v_extra = Some({v_params = _ :: _}) }) when com.platform = Cs || (com.platform = Java && not (Common.defined com Define.Jvm)) -> (* Java/C# use a special handling for functions with type parmaters *) () | Declare v -> @@ -256,13 +256,16 @@ let captured_vars com e = decr depth; | Declare v -> vars := PMap.add v.v_id !depth !vars; - | Use ({ v_extra = Some( _ :: _, _) }) - | Assign ({ v_extra = Some( _ :: _, _) }) when com.platform = Cs || (com.platform = Java && not (Common.defined com Define.Jvm)) -> + | Use ({ v_extra = Some({v_params = _ :: _}) }) + | Assign ({ v_extra = Some({v_params = _ :: _}) }) when com.platform = Cs || (com.platform = Java && not (Common.defined com Define.Jvm)) -> () | Use v -> (try let d = PMap.find v.v_id !vars in - if d <> !depth then used := PMap.add v.v_id v !used; + if d <> !depth then begin + used := PMap.add v.v_id v !used; + if has_var_flag v VAssigned then assigned := PMap.add v.v_id v !assigned; + end with Not_found -> ()) | Assign v -> (try @@ -274,13 +277,15 @@ let captured_vars com e = end (* same depth but assigned after being used on a different depth - needs wrap *) else if PMap.mem v.v_id !used then - assigned := PMap.add v.v_id v !assigned; + assigned := PMap.add v.v_id v !assigned + else + add_var_flag v VAssigned; with Not_found -> ()) in local_usage collect_vars e; (* mark all capture variables - also used in rename_local_vars at later stage *) - PMap.iter (fun _ v -> v.v_capture <- true) !used; + PMap.iter (fun _ v -> add_var_flag v VCaptured) !used; !assigned in diff --git a/src/filters/exceptions.ml b/src/filters/exceptions.ml index d972aee4..7cb2bb23 100644 --- a/src/filters/exceptions.ml +++ b/src/filters/exceptions.ml @@ -275,6 +275,7 @@ let catch_native ctx catches t p = (* Everything else falls into `if(Std.is(e, ExceptionType)`-fest *) | rest -> let catch_var = alloc_var VGenerated "`" ctx.wildcard_catch_type null_pos in + add_var_flag catch_var VCaught; let catch_local = mk (TLocal catch_var) catch_var.v_type null_pos in let body = let catch = new catch ctx catch_local p in @@ -526,7 +527,7 @@ let patch_constructors tctx = | TInst(cls,_) when PMap.mem "__shiftStack" cls.cl_fields -> (fun mt -> match mt with - | TClassDecl cls when not cls.cl_extern && cls.cl_path <> haxe_exception_type_path && is_haxe_exception_class cls -> + | 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 @@ -570,4 +571,4 @@ let patch_constructors tctx = ) | _ -> () ) - | _ -> (fun _ -> ()) \ No newline at end of file + | _ -> (fun _ -> ()) diff --git a/src/filters/filters.ml b/src/filters/filters.ml index a70f41c1..d4ee0a3a 100644 --- a/src/filters/filters.ml +++ b/src/filters/filters.ml @@ -243,7 +243,7 @@ let check_unification ctx e t = begin match e.eexpr,t with | TLocal v,TType({t_path = ["cs"],("Ref" | "Out")},_) -> (* TODO: this smells of hack, but we have to deal with it somehow *) - v.v_capture <- true + add_var_flag v VCaptured; | _ -> () end; @@ -318,7 +318,7 @@ let save_class_state ctx t = match t with List.fold_left (fun pmap f -> PMap.add f.cf_name f pmap) PMap.empty lst in - let meta = c.cl_meta and path = c.cl_path and ext = c.cl_extern and over = c.cl_overrides in + let meta = c.cl_meta and path = c.cl_path and ext = (has_class_flag c CExtern) in let sup = c.cl_super and impl = c.cl_implements in let csr = Option.map (mk_field_restore) c.cl_constructor in let ofr = List.map (mk_field_restore) c.cl_ordered_fields in @@ -329,7 +329,7 @@ let save_class_state ctx t = match t with c.cl_super <- sup; c.cl_implements <- impl; c.cl_meta <- meta; - c.cl_extern <- ext; + if ext then add_class_flag c CExtern else remove_class_flag c CExtern; c.cl_path <- path; c.cl_init <- init; c.cl_ordered_fields <- List.map restore_field ofr; @@ -337,7 +337,6 @@ let save_class_state ctx t = match t with c.cl_fields <- mk_pmap c.cl_ordered_fields; c.cl_statics <- mk_pmap c.cl_ordered_statics; c.cl_constructor <- Option.map restore_field csr; - c.cl_overrides <- over; c.cl_descendants <- []; List.iter (fun (v, t) -> v.v_type <- t) !vars; ) @@ -348,7 +347,7 @@ let save_class_state ctx t = match t with let remove_generic_base ctx t = match t with | TClassDecl c when is_removable_class c -> - c.cl_extern <- true + add_class_flag c CExtern; | _ -> () @@ -420,6 +419,26 @@ let apply_native_paths ctx t = c.cl_meta <- meta :: c.cl_meta; c.cl_path <- path; | TEnumDecl e -> + let did_change = ref false in + let field _ ef = try + let meta,name = get_real_name ef.ef_meta ef.ef_name in + ef.ef_name <- name; + ef.ef_meta <- meta :: ef.ef_meta; + did_change := true; + with Not_found -> + () + in + PMap.iter field e.e_constrs; + if !did_change then begin + let names = ref [] in + e.e_constrs <- PMap.fold + (fun ef map -> + names := ef.ef_name :: !names; + PMap.add ef.ef_name ef map + ) + e.e_constrs PMap.empty; + e.e_names <- !names; + end; let meta,path = get_real_path e.e_meta e.e_path in e.e_meta <- meta :: e.e_meta; e.e_path <- path; @@ -519,7 +538,7 @@ let add_meta_field ctx t = match t with | Cs | Java -> false | _ -> true in - if c.cl_interface && not (can_deal_with_interface_metadata()) then begin + if (has_class_flag c CInterface) && not (can_deal_with_interface_metadata()) then begin (* borrowed from gencommon, but I did wash my hands afterwards *) let path = fst c.cl_path,snd c.cl_path ^ "_HxMeta" in let ncls = mk_class c.cl_module path c.cl_pos null_pos in @@ -540,7 +559,7 @@ let add_meta_field ctx t = match t with this filter checks for their existence and also adds some metadata for analyzer and C# generator *) let check_cs_events com t = match t with - | TClassDecl cl when not cl.cl_extern -> + | TClassDecl cl when not (has_class_flag cl CExtern) -> let check fields f = match f.cf_kind with | Var { v_read = AccNormal; v_write = AccNormal } when Meta.has Meta.Event f.cf_meta -> @@ -605,7 +624,7 @@ let check_void_field ctx t = match t with This makes the first extended (implemented) interface the super for efficiency reasons (you can get one for 'free') and leaves the remaining ones as 'implemented' *) let promote_first_interface_to_super ctx t = match t with - | TClassDecl c when c.cl_interface -> + | TClassDecl c when (has_class_flag c CInterface) -> begin match c.cl_implements with | ({ cl_path = ["cpp";"rtti"],_ },_ ) :: _ -> () | first_interface :: remaining -> @@ -628,7 +647,7 @@ let check_reserved_type_paths ctx t = ctx.com.warning ("Type path " ^ (s_type_path path) ^ " is reserved on this target") pos in match t with - | TClassDecl c when not c.cl_extern -> check c.cl_path c.cl_pos + | TClassDecl c when not (has_class_flag c CExtern) -> check c.cl_path c.cl_pos | TEnumDecl e when not e.e_extern -> check e.e_path e.e_pos | _ -> () @@ -642,7 +661,7 @@ let is_cached t = m.m_processed <> !pp_counter let apply_filters_once ctx filters t = - if not (is_cached t) then run_expression_filters ctx filters t + if not (is_cached t) then run_expression_filters None ctx filters t let next_compilation() = incr pp_counter @@ -663,6 +682,10 @@ let iter_expressions fl mt = let filter_timer detailed s = Timer.timer (if detailed then "filters" :: s else ["filters"]) +let timer_label detailed s = + if detailed then Some ("filters" :: s) + else None + module ForRemap = struct let apply ctx e = let rec loop e = match e.eexpr with @@ -673,7 +696,10 @@ module ForRemap = struct let restore = save_locals ctx in let e = ForLoop.IterationKind.to_texpr ctx v iterator e2 e.epos in restore(); - e + begin match e.eexpr with + | TFor _ -> for_remap ctx.com.basic v e1 e2 e.epos + | _ -> e + end | _ -> Type.map_expr loop e in @@ -709,22 +735,20 @@ let run com tctx main = NullSafety.run com new_types; (* PASS 1: general expression filters *) let filters = [ - ForRemap.apply tctx; - VarLazifier.apply com; - AbstractCast.handle_abstract_casts tctx; + "ForRemap",ForRemap.apply tctx; + "VarLazifier",VarLazifier.apply com; + "handle_abstract_casts",AbstractCast.handle_abstract_casts tctx; ] in - let t = filter_timer detail_times ["expr 0"] in - List.iter (run_expression_filters tctx filters) new_types; - t(); + List.iter (run_expression_filters (timer_label detail_times ["expr 0"]) tctx filters) new_types; let filters = [ - fix_return_dynamic_from_void_function tctx true; - check_local_vars_init tctx.com; - check_abstract_as_value; - if defined com Define.AnalyzerOptimize then Tre.run tctx else (fun e -> e); - Optimizer.reduce_expression tctx; - if Common.defined com Define.OldConstructorInline then Optimizer.inline_constructors tctx else InlineConstructors.inline_constructors tctx; - Exceptions.filter tctx; - CapturedVars.captured_vars com; + "fix_return_dynamic_from_void_function",fix_return_dynamic_from_void_function tctx true; + "check_local_vars_init",check_local_vars_init tctx.com; + "check_abstract_as_value",check_abstract_as_value; + "Tre",if defined com Define.AnalyzerOptimize then Tre.run tctx else (fun e -> e); + "reduce_expression",Optimizer.reduce_expression tctx; + "inline_constructors",InlineConstructors.inline_constructors tctx; + "Exceptions_filter",Exceptions.filter tctx; + "captured_vars",CapturedVars.captured_vars com; ] in let filters = match com.platform with @@ -736,9 +760,7 @@ let run com tctx main = filters | _ -> filters in - let t = filter_timer detail_times ["expr 1"] in - List.iter (run_expression_filters tctx filters) new_types; - t(); + List.iter (run_expression_filters (timer_label detail_times ["expr 1"]) tctx filters) new_types; (* PASS 1.5: pre-analyzer type filters *) let filters = match com.platform with @@ -762,16 +784,14 @@ let run com tctx main = com.stage <- CAnalyzerDone; let locals = RenameVars.init com in let filters = [ - Optimizer.sanitize com; - if com.config.pf_add_final_return then add_final_return else (fun e -> e); - (match com.platform with + "sanitize",Optimizer.sanitize com; + "add_final_return",if com.config.pf_add_final_return then add_final_return else (fun e -> e); + "RenameVars",(match com.platform with | Eval -> (fun e -> e) | _ -> RenameVars.run tctx locals); - mark_switch_break_loops; + "mark_switch_break_loops",mark_switch_break_loops; ] in - let t = filter_timer detail_times ["expr 2"] in - List.iter (run_expression_filters tctx filters) new_types; - t(); + List.iter (run_expression_filters (timer_label detail_times ["expr 2"]) tctx filters) new_types; next_compilation(); let t = filter_timer detail_times ["callbacks"] in List.iter (fun f -> f()) (List.rev com.callbacks#get_before_save); (* macros onGenerate etc. *) @@ -808,7 +828,13 @@ let run com tctx main = t(); com.stage <- CDceDone; (* PASS 3: type filters post-DCE *) - List.iter (run_expression_filters tctx [Exceptions.insert_save_stacks tctx]) new_types; + List.iter + (run_expression_filters + (timer_label detail_times []) + tctx + ["insert_save_stacks",Exceptions.insert_save_stacks tctx] + ) + new_types; let type_filters = [ Exceptions.patch_constructors; check_private_path; diff --git a/src/filters/filtersCommon.ml b/src/filters/filtersCommon.ml index 6d9bad46..c29bdb20 100644 --- a/src/filters/filtersCommon.ml +++ b/src/filters/filtersCommon.ml @@ -48,9 +48,19 @@ let is_overridden cls field = in List.exists (fun d -> loop_inheritance d) cls.cl_descendants -let run_expression_filters ctx filters t = +let run_expression_filters time_details ctx filters t = let run e = - List.fold_left (fun e f -> f e) e filters + List.fold_left + (fun e (filter_name,f) -> + match time_details with + | Some timer_label -> + let t = Timer.timer (timer_label @ [filter_name]) in + let e = f e in + t(); + e + | None -> f e + ) + e filters in match t with | TClassDecl c when is_removable_class c -> () diff --git a/src/filters/renameVars.ml b/src/filters/renameVars.ml index a340c037..db03f085 100644 --- a/src/filters/renameVars.ml +++ b/src/filters/renameVars.ml @@ -23,22 +23,26 @@ let reserve_init ri name = ri.ri_reserved <- StringMap.add name true ri.ri_reserved (** - Make all class names reserved names. - No local variable will have a name matching a class. + Make all module-level names reserved. + No local variable will have a name matching a module-level declaration. *) let reserve_all_types ri com path_to_name = List.iter (fun mt -> let tinfos = t_infos mt in let native_name = try fst (TypeloadCheck.get_native_name tinfos.mt_meta) with Not_found -> path_to_name tinfos.mt_path in - if native_name = "" then - match mt with - | TClassDecl c -> - List.iter (fun cf -> - let native_name = try fst (TypeloadCheck.get_native_name cf.cf_meta) with Not_found -> cf.cf_name in - reserve_init ri native_name - ) c.cl_ordered_statics; - | _ -> () - else + match mt with + | TClassDecl c when native_name = "" -> + List.iter (fun cf -> + let native_name = try fst (TypeloadCheck.get_native_name cf.cf_meta) with Not_found -> cf.cf_name in + reserve_init ri native_name + ) c.cl_ordered_statics + | TClassDecl { cl_kind = KModuleFields m; cl_ordered_statics = fl } -> + let prefix = Path.flat_path m.m_path ^ "_" in + List.iter (fun cf -> + let name = try fst (TypeloadCheck.get_native_name cf.cf_meta) with Not_found -> prefix ^ cf.cf_name in + reserve_init ri name + ) fl + | _ -> reserve_init ri native_name ) com.types @@ -292,7 +296,7 @@ let maybe_rename_var rc reserved (v,overlaps) = name := v.v_name ^ (string_of_int !count); done; v.v_name <- !name; - if rc.rc_no_shadowing || (v.v_capture && rc.rc_hoisting) then reserve reserved v.v_name + if rc.rc_no_shadowing || (has_var_flag v VCaptured && rc.rc_hoisting) then reserve reserved v.v_name (** Rename variables found in `scope` diff --git a/src/filters/tre.ml b/src/filters/tre.ml index 14f1756f..3c1930a0 100644 --- a/src/filters/tre.ml +++ b/src/filters/tre.ml @@ -99,7 +99,7 @@ let is_recursive_named_local_call fn_var callee args = let is_recursive_method_call cls field callee args = match callee.eexpr, args with (* member abstract function*) - | TField (_, FStatic (_, cf)), { eexpr = TLocal v } :: _ when has_meta Meta.Impl cf.cf_meta -> + | TField (_, FStatic (_, cf)), { eexpr = TLocal v } :: _ when has_class_field_flag cf CfImpl -> cf == field && has_meta Meta.This v.v_meta (* static method *) | TField (_, FStatic (_, cf)), _ -> diff --git a/src/filters/varLazifier.ml b/src/filters/varLazifier.ml index b22dba8d..6bfd871f 100644 --- a/src/filters/varLazifier.ml +++ b/src/filters/varLazifier.ml @@ -22,6 +22,17 @@ let apply com e = let _,e2 = loop var_inits e2 in let eo = match eo with None -> None | Some e -> Some (snd (loop var_inits e)) in var_inits,{e with eexpr = TIf(e1,e2,eo)} + | TWhile(e1,e2,flag) -> + let var_inits,e1 = loop var_inits e1 in + let _,e2 = loop var_inits e2 in + var_inits,{e with eexpr = TWhile(e1,e2,flag)} + | TTry(e1,catches) -> + let _,e1 = loop var_inits e1 in + let catches = List.map (fun (v,e) -> + let _,e = loop var_inits e in + (v,e) + ) catches in + var_inits,{e with eexpr = TTry(e1,catches)} | TSwitch(e1,cases,edef) -> let var_inits,e1 = loop var_inits e1 in let cases = List.map (fun (el,e) -> diff --git a/src/generators/flashProps.ml b/src/generators/flashProps.ml index 18e29d44..7c20ee44 100644 --- a/src/generators/flashProps.ml +++ b/src/generators/flashProps.ml @@ -37,7 +37,7 @@ let find_property_for_accessor ~isget cl tl accessor_name = None let is_extern_instance_accessor ~isget cl tl cf = - if cl.cl_extern && (if isget then is_getter_name cf.cf_name else is_setter_name cf.cf_name) then + if (has_class_flag cl CExtern) && (if isget then is_getter_name cf.cf_name else is_setter_name cf.cf_name) then find_property_for_accessor ~isget cl tl cf.cf_name else None @@ -54,7 +54,7 @@ let find_static_property_for_accessor ~isget cl accessor_name = None let is_extern_static_accessor ~isget cl cf = - if cl.cl_extern && (if isget then is_getter_name cf.cf_name else is_setter_name cf.cf_name) then + if (has_class_flag cl CExtern) && (if isget then is_getter_name cf.cf_name else is_setter_name cf.cf_name) then find_static_property_for_accessor ~isget cl cf.cf_name else None diff --git a/src/generators/gencpp.ml b/src/generators/gencpp.ml index 54c33ad9..3256d183 100644 --- a/src/generators/gencpp.ml +++ b/src/generators/gencpp.ml @@ -16,7 +16,7 @@ along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. *) - +open Extlib_leftovers open Ast open Type open Common @@ -609,7 +609,7 @@ let rec remove_parens_cast expression = let is_interface_type t = match follow t with - | TInst (klass,params) -> klass.cl_interface + | TInst (klass,params) -> (has_class_flag klass CInterface) | _ -> false ;; @@ -625,12 +625,12 @@ let is_cpp_function_instance haxe_type = let is_objc_class klass = - klass.cl_extern && Meta.has Meta.Objc klass.cl_meta + (has_class_flag klass CExtern) && Meta.has Meta.Objc klass.cl_meta ;; let rec is_objc_type t = match t with - | TInst(cl,_) -> cl.cl_extern && Meta.has Meta.Objc cl.cl_meta + | TInst(cl,_) -> (has_class_flag cl CExtern) && Meta.has Meta.Objc cl.cl_meta | TType(td,_) -> (Meta.has Meta.Objc td.t_meta) | TAbstract (a,_) -> (Meta.has Meta.Objc a.a_meta) | TMono r -> (match r.tm_type with | Some t -> is_objc_type t | _ -> false) @@ -688,7 +688,16 @@ let is_native_gen_module = function | _ -> false ;; +let is_extern_class class_def = + (has_class_flag class_def CExtern) || (has_meta_key class_def.cl_meta Meta.Extern) || + (match class_def.cl_kind with + | KAbstractImpl abstract_def -> (has_meta_key abstract_def.a_meta Meta.Extern) + | _ -> false ); +;; +let is_native_class class_def = + ((is_extern_class class_def) || (is_native_gen_class class_def)) && (not (is_internal_class class_def.cl_path)) +;; (* Get a string to represent a type. The "suffix" will be nothing or "_obj", depending if we want the name of the @@ -735,16 +744,16 @@ let rec class_string klass suffix params remap = let str = join_class_path_remap klass.cl_path "::" in if suffix = "_obj" then str - else if klass.cl_interface then + else if (has_class_flag klass CInterface) then "id < " ^ str ^ ">" else str ^ " *" (* Native interface - use pointer *) - | _ when klass.cl_interface && is_native_gen_class klass -> + | _ when (has_class_flag klass CInterface) && is_native_gen_class klass -> (join_class_path_remap klass.cl_path "::") ^ " *" (* Normal class *) - | path when klass.cl_extern && (not (is_internal_class path) )-> - (join_class_path_remap klass.cl_path "::") ^ suffix + | _ when is_native_class klass -> + join_class_path_remap klass.cl_path "::" | _ -> let globalNamespace = if (get_meta_string klass.cl_meta Meta.Native)<>"" then "" else "::" in globalNamespace ^ (join_class_path_remap klass.cl_path "::") ^ suffix @@ -951,13 +960,6 @@ let is_interface obj = is_interface_type obj.etype;; let should_implement_field x = is_physical_field x;; -let is_extern_class class_def = - class_def.cl_extern || (has_meta_key class_def.cl_meta Meta.Extern) || - (match class_def.cl_kind with - | KAbstractImpl abstract_def -> (has_meta_key abstract_def.a_meta Meta.Extern) - | _ -> false ); -;; - let is_scalar_abstract abstract_def = Meta.has Meta.Scalar abstract_def.a_meta && Meta.has Meta.CoreType abstract_def.a_meta ;; @@ -974,7 +976,7 @@ List.filter (function (t,pl) -> let is_extern_class_instance obj = match follow obj.etype with - | TInst (klass,params) -> klass.cl_extern + | TInst (klass,params) -> (has_class_flag klass CExtern) | _ -> false ;; @@ -1294,6 +1296,14 @@ let strip_file ctx file = (match Common.defined ctx Common.Define.AbsolutePath w tail) ;; +let with_debug ctx metadata run = + let old_debug = ctx.ctx_debug_level in + let no_debug = has_meta_key metadata Meta.NoDebug in + if no_debug then ctx.ctx_debug_level <- 0; + run no_debug; + ctx.ctx_debug_level <- old_debug; +;; + let hx_stack_push ctx output clazz func_name pos gc_stack = if ctx.ctx_debug_level > 0 then begin let stripped_file = strip_file ctx.ctx_common pos.pfile in @@ -1459,6 +1469,7 @@ and tcpp_expr_expr = | CppEnumField of tenum * tenum_field | CppCall of tcppfuncloc * tcppexpr list | CppFunctionAddress of tclass * tclass_field + | CppNewNative of tcppexpr | CppAddressOf of tcppexpr | CppDereference of tcppexpr | CppArray of tcpparrayloc @@ -1538,6 +1549,7 @@ let rec s_tcpp = function | CppCall (FuncInternal _,_) -> "CppCallInternal" | CppCall (FuncExtern _,_) -> "CppCallExtern" | CppCall (FuncFromStaticFunction,_) -> "CppCallFromStaticFunction" + | CppNewNative _ -> "CppNewNative" | CppAddressOf _ -> "CppAddressOf" | CppDereference _ -> "CppDereference" | CppFunctionAddress _ -> "CppFunctionAddress" @@ -1608,7 +1620,7 @@ and tcpp_to_string_suffix suffix tcpp = match tcpp with | TCppScalarArray(value) -> "::Array" ^ suffix ^ "< " ^ (tcpp_to_string value) ^ " >" | TCppObjC klass -> let path = join_class_path_remap klass.cl_path "::" in - if klass.cl_interface then + if (has_class_flag klass CInterface) then "id < " ^ path ^ ">" else path ^ " *" @@ -1623,7 +1635,7 @@ and tcpp_to_string_suffix suffix tcpp = match tcpp with else "::hx::Native< " ^ name ^ "* >"; | TCppInst klass -> - (cpp_class_path_of klass) ^ suffix + (cpp_class_path_of klass) ^ (if is_native_class klass then "" else suffix) | TCppInterface klass when suffix="_obj" -> (cpp_class_path_of klass) ^ suffix | TCppInterface _ -> "::Dynamic" @@ -1749,7 +1761,7 @@ let rec cpp_type_of stack ctx haxe_type = | TAbstract (abs,pl) when not (Meta.has Meta.CoreType abs.a_meta) -> cpp_type_from_path stack ctx abs.a_path pl (fun () -> - cpp_type_of stack ctx (Abstract.get_underlying_type abs pl) ) + cpp_type_of stack ctx (Abstract.get_underlying_type ~return_first:true abs pl) ) | TAbstract (a,params) -> cpp_type_from_path stack ctx a.a_path params (fun () -> @@ -1817,11 +1829,11 @@ let rec cpp_type_of stack ctx haxe_type = | (("cpp"::["objc"]),"ObjcBlock"), [function_type] -> let args,ret = (cpp_function_type_of_args_ret stack ctx function_type) in TCppObjCBlock(args,ret) - | (["haxe";"extern"], "Rest"),[rest] -> + | ((["cpp"]), "Rest"),[rest] -> TCppRest(cpp_type_of stack ctx rest) | (("cpp"::["objc"]),"Protocol"), [interface_type] -> (match follow interface_type with - | TInst (klass,[]) when klass.cl_interface -> + | TInst (klass,[]) when (has_class_flag klass CInterface) -> TCppProtocol(klass) (* TODO - get the line number here *) | _ -> print_endline "cpp.objc.Protocol must refer to an interface"; @@ -1913,11 +1925,11 @@ let rec cpp_type_of stack ctx haxe_type = cpp_type_from_path stack ctx klass.cl_path params (fun () -> if is_objc_class klass then TCppObjC(klass) - else if klass.cl_interface && is_native_gen_class klass then + else if (has_class_flag klass CInterface) && is_native_gen_class klass then TCppNativePointer(klass) - else if klass.cl_interface then + else if (has_class_flag klass CInterface) then TCppInterface(klass) - else if klass.cl_extern && (not (is_internal_class klass.cl_path) ) then + else if (has_class_flag klass CExtern) && (not (is_internal_class klass.cl_path) ) then TCppInst(klass) else TCppInst(klass) @@ -2003,7 +2015,7 @@ let cpp_class_name klass = *) let globalNamespace = if (get_meta_string klass.cl_meta Meta.Native)<>"" then "" else "::" in let path = globalNamespace ^ (join_class_path_remap klass.cl_path "::") in - if path="::String" then path else path ^ "_obj" + if (is_native_class klass) || path="::String" then path else path ^ "_obj" ;; @@ -2086,7 +2098,20 @@ let is_complex_compare = function | _ -> true ;; +let is_pointer_compare = function + | TCppObjectArray _ + | TCppScalarArray _ + | TCppDynamicArray + | TCppClass + | TCppEnum _ -> true + | _ -> false +;; +let is_instance_compare = function + | TCppInterface _ + | TCppInst _ -> true + | _ -> false +;; let ctx_arg_type_name ctx name default_val arg_type prefix = let remap_name = keyword_remap name in @@ -2444,7 +2469,7 @@ let retype_expression ctx request_type function_args function_type expression_tr end else begin (*print_endline ("Missing tvar " ^ tvar.v_name);*) Hashtbl.replace !undeclared name tvar; - if tvar.v_capture then + if has_var_flag tvar VCaptured then CppVar(VarClosure(tvar)), cpp_type_of tvar.v_type else CppExtern(name,false), cpp_type_of tvar.v_type @@ -2494,7 +2519,7 @@ let retype_expression ctx request_type function_args function_type expression_tr if retypedObj.cpptype=TCppNull then CppNullAccess, TCppDynamic - else if retypedObj.cpptype=TCppDynamic && not clazz.cl_interface then begin + else if retypedObj.cpptype=TCppDynamic && not (has_class_flag clazz CInterface) then begin if is_internal_member member.cf_name then CppFunction( FuncInstance(retypedObj,InstPtr,member), funcReturn ), exprType else @@ -2504,6 +2529,8 @@ let retype_expression ctx request_type function_args function_type expression_tr match retypedObj.cppexpr with | CppThis ThisReal -> CppVar(VarThis(member, retypedObj.cpptype)), exprType + | CppSuper this -> + CppFunction( FuncSuper(this, retypedObj.cpptype,member), funcReturn ), exprType | _ -> if (is_var_field member) then CppVar( VarInstance(retypedObj,member,tcpp_to_string clazzType, ".") ), exprType else @@ -2537,7 +2564,7 @@ let retype_expression ctx request_type function_args function_type expression_tr let operator = if cpp_is_struct_access retypedObj.cpptype || retypedObj.cpptype=TCppString then "." else "->" in CppVar(VarInstance(retypedObj,member,tcpp_to_string clazzType, operator) ), exprType ) - end else if (clazz.cl_interface && not is_objc (* Use instance call for objc interfaces *)) then + end else if ((has_class_flag clazz CInterface) && not is_objc (* Use instance call for objc interfaces *)) then CppFunction( FuncInterface(retypedObj,clazz,member), funcReturn ), exprType else begin let isArrayObj = match retypedObj.cpptype with @@ -2689,7 +2716,8 @@ let retype_expression ctx request_type function_args function_type expression_tr | CppFunction( FuncStatic(obj, false, member), _ ) when member.cf_name = "::hx::Dereference" -> let arg = retype TCppUnchanged (List.hd args) in - CppDereference(arg), arg.cpptype + let rawType = match arg.cpptype with | TCppStar(x,_) -> x | x -> x in + CppDereference(arg), TCppReference(rawType) | CppFunction( FuncStatic(obj, false, member), _ ) when member.cf_name = "_hx_create_array_length" -> let retypedArgs = List.map (retype TCppDynamic ) args in @@ -2806,16 +2834,14 @@ let retype_expression ctx request_type function_args function_type expression_tr ) | TNew (class_def,params,args) -> - let rec find_constructor c = (match c.cl_constructor, c.cl_super with - | (Some constructor), _ -> constructor.cf_type - | _ , Some (super,_) -> find_constructor super - | _ -> abort "TNew without constructor " expr.epos - ) in - let constructor_type = find_constructor class_def in + let constructor_type = match OverloadResolution.maybe_resolve_constructor_overload class_def params args with + | None -> abort "Could not find overload" expr.epos + | Some (_,constructor,_) -> constructor.cf_type + in let arg_types, _ = cpp_function_type_of_args_ret ctx constructor_type in let retypedArgs = retype_function_args args arg_types in let created_type = cpp_type_of expr.etype in - gc_stack := !gc_stack || (match created_type with | TCppInst(_) -> true | _ -> false ); + gc_stack := !gc_stack || (match created_type with | TCppInst(t) -> not (is_native_class t) | _ -> false ); CppCall( FuncNew(created_type), retypedArgs), created_type | TFunction func -> @@ -2900,6 +2926,8 @@ let retype_expression ctx request_type function_args function_type expression_tr let e2 = retype binOpType right in let complex = (is_complex_compare e1.cpptype) || (is_complex_compare e2.cpptype) in + let pointer = (is_pointer_compare e1.cpptype) || (is_pointer_compare e2.cpptype) in + let instance = (is_instance_compare e1.cpptype) || (is_instance_compare e2.cpptype) in let e1_null = e1.cpptype=TCppNull in let e2_null = e2.cpptype=TCppNull in let reference = match op with @@ -2927,6 +2955,12 @@ let retype_expression ctx request_type function_args function_type expression_tr | OpLte when e2_null -> CppNullCompare("IsNull", e1) | OpNotEq when e2_null -> CppNullCompare("IsNotNull", e1) + | OpEq when instance -> CppCompare("IsInstanceEq", e1, e2, op) + | OpNotEq when instance -> CppCompare("IsInstanceNotEq", e1, e2, op) + + | OpEq when pointer -> CppCompare("IsPointerEq", e1, e2, op) + | OpNotEq when pointer -> CppCompare("IsPointerNotEq", e1, e2, op) + | OpEq when complex -> CppCompare("IsEq", e1, e2, op) | OpNotEq when complex -> CppCompare("IsNotEq", e1, e2, op) | OpGte when complex -> CppCompare("IsGreaterEq", e1, e2, op) @@ -2963,6 +2997,7 @@ let retype_expression ctx request_type function_args function_type expression_tr | Neg -> CppUnop(CppNeg,e1) | Not -> CppUnop(CppNot,e1) | NegBits -> CppUnop(CppNegBits,e1) + | Spread -> die ~p:expr.epos "Unexpected spread operator" __LOC__ in reference, cpp_type_of expr.etype | TFor (v,init,block) -> @@ -3226,11 +3261,16 @@ let retype_expression ctx request_type function_args function_type expression_tr let ptrCast = mk_cppexpr (CppCast(cppExpr,ptrType)) ptrType in mk_cppexpr (CppCast(ptrCast,TCppDynamic)) TCppDynamic - + | TCppStar(t,const), TCppReference _ | TCppStar(t,const), TCppInst _ | TCppStar(t,const), TCppStruct _ -> mk_cppexpr (CppDereference(cppExpr)) return_type + | TCppInst(t), TCppStar _ when (is_native_class t) && (match cppExpr.cppexpr with + | CppCall(FuncNew(_), _) -> true + | _ -> false) -> + mk_cppexpr (CppNewNative(cppExpr)) return_type + | TCppInst _, TCppStar(p,const) | TCppStruct _, TCppStar(p,const) -> mk_cppexpr (CppAddressOf(cppExpr)) return_type @@ -3382,7 +3422,7 @@ let rec implements_native_interface class_def = ;; let can_quick_alloc klass = - not (implements_native_interface klass) + (not (is_native_class klass)) && (not (implements_native_interface klass)) ;; @@ -3546,6 +3586,7 @@ let gen_cpp_ast_expression_tree ctx class_name func_name function_args function_ out (")") | CppCall(func, args) -> + let doCall = ref true in let closeCall = ref "" in let argsRef = ref args in (match func with @@ -3594,10 +3635,17 @@ let gen_cpp_ast_expression_tree ctx class_name func_name function_args function_ | FuncEnumConstruct(enum,field) -> out ((string_of_path enum.e_path) ^ "::" ^ (cpp_enum_name_of field)); - | FuncSuperConstruct _ -> out ((if not ctx.ctx_real_this_ptr then "__this->" else "") ^ "super::__construct") + | FuncSuperConstruct(TCppInst klass) when is_native_class klass -> + doCall := false; + + | FuncSuperConstruct _ -> + out ((if not ctx.ctx_real_this_ptr then "__this->" else "") ^ "super::__construct") + + | FuncSuper(_,TCppInst(klass),field) when is_native_class klass -> + out ((cpp_class_path_of klass) ^ "::" ^ (cpp_member_name_of field)); | FuncSuper(this,_,field) -> - out ( (if this==ThisReal then "this->" else "__->") ^ "super::" ^ (cpp_member_name_of field) ) + out ( (if this==ThisReal then "this->" else "__->") ^ "super::" ^ (cpp_member_name_of field) ) | FuncNew(newType) -> let objName = match newType with @@ -3607,6 +3655,7 @@ let gen_cpp_ast_expression_tree ctx class_name func_name function_args function_ | TCppScalarArray(value) -> "::Array_obj< " ^ (tcpp_to_string value) ^ " >::__new" | TCppObjC klass -> (cpp_class_path_of klass) ^ "_obj::__new" | TCppNativePointer klass -> "new " ^ (cpp_class_path_of klass); + | TCppInst klass when is_native_class klass -> cpp_class_path_of klass | TCppInst klass -> (cpp_class_path_of klass) ^ "_obj::__new" | TCppClass -> "::hx::Class_obj::__new"; | TCppFunction _ -> tcpp_to_string newType @@ -3623,13 +3672,17 @@ let gen_cpp_ast_expression_tree ctx class_name func_name function_args function_ | FuncExpression(expr) -> gen expr; ); - let sep = ref "" in - out "("; - List.iter (fun arg -> - out !sep; sep := ","; - gen arg; - ) !argsRef; - out (")" ^ !closeCall); + if !doCall then begin + let sep = ref "" in + out "("; + List.iter (fun arg -> + out !sep; sep := ","; + gen arg; + ) !argsRef; + out (")" ^ !closeCall); + end + | CppNewNative(e) -> + out "new "; gen e; | CppAddressOf(e) -> out ("&("); gen e; out ")"; | CppDereference(e) -> @@ -4058,7 +4111,7 @@ let gen_cpp_ast_expression_tree ctx class_name func_name function_args function_ | CppCastObjC(expr,klass) -> let path = join_class_path_remap klass.cl_path "::" in - let toType = if klass.cl_interface then "id < " ^ path ^ ">" else path ^ " *" in + let toType = if (has_class_flag klass CInterface) then "id < " ^ path ^ ">" else path ^ " *" in out ("( (" ^ toType ^ ") (id) ("); gen expr; out ") )" | CppCastObjCBlock(expr,args,ret) -> @@ -4280,8 +4333,8 @@ let is_data_member field = | _ -> false;; -let is_override class_def field = - List.exists (fun f -> f.cf_name = field) class_def.cl_overrides +let is_override field = + has_class_field_flag field CfOverride ;; (* @@ -4294,7 +4347,7 @@ let current_virtual_functions_rev clazz base_functions = List.fold_left (fun result elem -> match follow elem.cf_type, elem.cf_kind with | _, Method MethDynamic -> result | TFun (args,return_type), Method _ -> - if (is_override clazz elem.cf_name ) then + if (is_override elem ) then List.map (fun (e,a,r) -> if e.cf_name<>elem.cf_name then (e,a,r) else (elem,args,return_type) ) result else (elem,args,return_type) :: result @@ -4431,7 +4484,7 @@ let gen_field ctx class_def class_name ptr_name dot_name is_static is_interface output "\n\n"; let nonVirtual = has_meta_key field.cf_meta Meta.NonVirtual in - let doDynamic = (nonVirtual || not (is_override class_def field.cf_name ) ) && (reflective class_def field ) in + let doDynamic = (nonVirtual || not (is_override field ) ) && (reflective class_def field ) in (* generate dynamic version too ... *) if ( doDynamic ) then begin let tcpp_args = List.map (fun (v,_) -> cpp_type_of ctx v.v_type ) function_def.tf_args in @@ -4515,6 +4568,16 @@ let gen_field ctx class_def class_name ptr_name dot_name is_static is_interface if is_static && is_physical_field field then begin gen_type ctx field.cf_type; output ( " " ^ class_name ^ "::" ^ remap_name ^ ";\n\n"); + end else if has_class_field_flag field CfAbstract then begin + let tl,tr = match follow field.cf_type with + | TFun(tl,tr) -> tl,tr + | _ -> die "" __LOC__ + in + let nargs = string_of_int (List.length tl) in + let return_type = (cpp_type_of ctx tr ) in + let is_void = return_type = TCppVoid in + let ret = if is_void then "(void)" else "return " in + output ("HX_DEFINE_DYNAMIC_FUNC" ^ nargs ^ "(" ^ class_name ^ "," ^ remap_name ^ "," ^ ret ^ ")\n\n"); end ) ;; @@ -4599,13 +4662,13 @@ let gen_member_def ctx class_def is_static is_interface field = end else begin let decl = get_meta_string field.cf_meta Meta.Decl in let has_decl = decl <> "" in + let nonVirtual = has_meta_key field.cf_meta Meta.NonVirtual in + let doDynamic = (nonVirtual || not (is_override field ) ) && (reflective class_def field ) in if (has_decl) then output ( " typedef " ^ decl ^ ";\n" ); output (if is_static then "\t\tstatic " else "\t\t"); (match field.cf_expr with | Some { eexpr = TFunction function_def } -> - let nonVirtual = has_meta_key field.cf_meta Meta.NonVirtual in - let doDynamic = (nonVirtual || not (is_override class_def field.cf_name ) ) && (reflective class_def field ) in if ( is_dynamic_haxe_method field ) then begin if ( doDynamic ) then begin output ("::Dynamic " ^ remap_name ^ ";\n"); @@ -4636,6 +4699,23 @@ let gen_member_def ctx class_def is_static is_interface field = end; end; output "\n"; + | _ when has_class_field_flag field CfAbstract -> + let ctx_arg_list ctx arg_list prefix = + String.concat "," (List.map (fun (n,o,t) -> (ctx_arg ctx n None t prefix) ) arg_list) + in + let tl,tr = match follow field.cf_type with + | TFun(tl,tr) -> tl,tr + | _ -> die "" __LOC__ + in + let return_type = (ctx_type_string ctx tr) in + let remap_name = native_field_name_remap is_static field in + output "virtual "; + output (if return_type="Void" then "void" else return_type ); + output (" " ^ remap_name ^ "(" ); + output (ctx_arg_list ctx tl "" ); + output ") = 0;\n"; + if doDynamic then + output (" ::Dynamic " ^ remap_name ^ "_dyn();\n" ); | _ when has_decl -> output ( remap_name ^ "_decl " ^ remap_name ^ ";\n" ); (* Variable access *) @@ -4720,7 +4800,7 @@ let find_referenced_types_flags ctx obj field_name super_deps constructor_deps h add_type klass.cl_path else begin let path = klass.cl_path in - if not klass.cl_interface then + if not (has_class_flag klass CInterface) then (* Always include native struct headers directly ... *) add_type ( path_of_string ( (join_class_path path "/") ^ ".h") ) else begin @@ -5020,7 +5100,7 @@ let generate_files common_ctx file_info = List.iter ( fun object_def -> (match object_def with | TClassDecl class_def when is_extern_class class_def -> ( ) - | TClassDecl class_def when class_def.cl_interface -> ( ) + | TClassDecl class_def when (has_class_flag class_def CInterface) -> ( ) | TClassDecl class_def -> output_files ((const_char_star (join_class_path class_def.cl_path "." )) ^ ",\n") | _ -> ( ) @@ -5311,6 +5391,7 @@ let is_abstract_impl class_def = match class_def.cl_kind with let variable_field field = (match field.cf_expr with | Some { eexpr = TFunction function_def } -> is_dynamic_haxe_method field + | None when has_class_field_flag field CfAbstract -> false | _ -> true) ;; @@ -5427,7 +5508,6 @@ let access_str a = match a with | AccNormal -> "AccNormal" | AccNo -> "AccNo" | AccNever -> "AccNever" - | AccResolve -> "AccResolve" | AccCall -> "AccCall" | AccInline -> "AccInline" | AccRequire(_,_) -> "AccRequire" @@ -5674,7 +5754,7 @@ let generate_class_files baseCtx super_deps constructor_deps class_def inScripta end in - let not_toString = fun (field,args,_) -> field.cf_name<>"toString" || class_def.cl_interface in + let not_toString = fun (field,args,_) -> field.cf_name<>"toString" || (has_class_flag class_def CInterface) in let functions = List.filter not_toString (all_virtual_functions class_def) in (* Constructor definition *) @@ -5715,14 +5795,11 @@ let generate_class_files baseCtx super_deps constructor_deps class_def inScripta if isHeader then begin match class_def.cl_constructor with | Some ( { cf_expr = Some ( { eexpr = TFunction(function_def) } ) } as definition ) -> - let old_debug = ctx.ctx_debug_level in - if has_meta_key definition.cf_meta Meta.NoDebug then - ctx.ctx_debug_level <- 0; - ctx.ctx_real_this_ptr <- false; - gen_cpp_function_body ctx class_def false "new" function_def "" "" (has_meta_key definition.cf_meta Meta.NoDebug); - out "\n"; - - ctx.ctx_debug_level <- old_debug; + with_debug ctx definition.cf_meta (fun no_debug -> + ctx.ctx_real_this_ptr <- false; + gen_cpp_function_body ctx class_def false "new" function_def "" "" no_debug; + out "\n"; + ) | _ -> () end else out ("\t__this->__construct(" ^ constructor_args ^ ");\n"); @@ -5732,6 +5809,45 @@ let generate_class_files baseCtx super_deps constructor_deps class_def inScripta end; in + let outputNativeConstructor ctx out isHeader = + match class_def.cl_constructor with + | Some ({ cf_expr = Some { eexpr = TFunction(function_def) } } as definition) -> + if isHeader then begin + out ("\t\t" ^ class_name ^ "(" ^ constructor_type_args ^ ");\n\n"); + end else begin + with_debug ctx definition.cf_meta (fun no_debug -> + ctx.ctx_real_this_ptr <- true; + out (class_name ^ "::" ^ class_name ^ "(" ^ constructor_type_args ^ ")"); + + (match class_def.cl_super with + | Some (klass, _) -> + let rec find_super_args = function + | TCall ({ eexpr = TConst TSuper }, args) :: _ -> Some args + | (TParenthesis(e) | TMeta(_,e) | TCast(e,None)) :: rest -> find_super_args (e.eexpr :: rest) + | TBlock e :: rest -> find_super_args ((List.map (fun e -> e.eexpr) e) @ rest) + | _ :: rest -> find_super_args rest + | _ -> None + in + (match find_super_args [function_def.tf_expr.eexpr] with + | Some args -> + out ("\n:" ^ (cpp_class_path_of klass) ^ "("); + let sep = ref "" in + List.iter (fun arg -> + out !sep; sep := ","; + gen_cpp_ast_expression_tree ctx "" "" [] t_dynamic None arg; + ) args; + out ")\n"; + | _ -> ()); + | _ -> ()); + + let head_code = get_code definition.cf_meta Meta.FunctionCode in + let tail_code = get_code definition.cf_meta Meta.FunctionTailCode in + gen_cpp_function_body ctx class_def false "new" function_def head_code tail_code no_debug; + ) + end + | _ -> () + in + (* State *) let header_glue = ref [] in @@ -5777,30 +5893,27 @@ let generate_class_files baseCtx super_deps constructor_deps class_def inScripta output_cpp ( get_class_code class_def Meta.CppNamespaceCode ); - if (not class_def.cl_interface) && not nativeGen then begin + if (not (has_class_flag class_def CInterface)) && not nativeGen then begin output_cpp ("void " ^ class_name ^ "::__construct(" ^ constructor_type_args ^ ")"); (match class_def.cl_constructor with | Some ( { cf_expr = Some ( { eexpr = TFunction(function_def) } ) } as definition ) -> - let old_debug = ctx.ctx_debug_level in - if has_meta_key definition.cf_meta Meta.NoDebug then - ctx.ctx_debug_level <- 0; - - gen_cpp_function_body ctx class_def false "new" function_def "" "" (has_meta_key definition.cf_meta Meta.NoDebug); - output_cpp "\n"; - - ctx.ctx_debug_level <- old_debug; + with_debug ctx definition.cf_meta (fun no_debug -> + gen_cpp_function_body ctx class_def false "new" function_def "" "" no_debug; + output_cpp "\n"; + ) | _ -> output_cpp " { }\n\n" ); (* Destructor goes in the cpp file so we can "see" the full definition of the member vars *) - output_cpp ("Dynamic " ^ class_name ^ "::__CreateEmpty() { return new " ^ class_name ^ "; }\n\n"); - output_cpp ("void *" ^ class_name ^ "::_hx_vtable = 0;\n\n"); - - output_cpp ("Dynamic " ^ class_name ^ "::__Create(::hx::DynamicArray inArgs)\n"); - output_cpp ("{\n\t" ^ ptr_name ^ " _hx_result = new " ^ class_name ^ "();\n"); - output_cpp ("\t_hx_result->__construct(" ^ (array_arg_list constructor_var_list) ^ ");\n"); - output_cpp ("\treturn _hx_result;\n}\n\n"); - + if not (has_class_flag class_def CAbstract) then begin + output_cpp ("Dynamic " ^ class_name ^ "::__CreateEmpty() { return new " ^ class_name ^ "; }\n\n"); + output_cpp ("void *" ^ class_name ^ "::_hx_vtable = 0;\n\n"); + + output_cpp ("Dynamic " ^ class_name ^ "::__Create(::hx::DynamicArray inArgs)\n"); + output_cpp ("{\n\t" ^ ptr_name ^ " _hx_result = new " ^ class_name ^ "();\n"); + output_cpp ("\t_hx_result->__construct(" ^ (array_arg_list constructor_var_list) ^ ");\n"); + output_cpp ("\treturn _hx_result;\n}\n\n"); + end; let rec addParent cls others = match cls.cl_super with | Some (super,_) -> ( try ( let parentId = Hashtbl.find ctx.ctx_type_ids (class_text super.cl_path) in @@ -5916,10 +6029,10 @@ let generate_class_files baseCtx super_deps constructor_deps class_def inScripta let dump_field_name = (fun field -> output_cpp ("\t" ^ (strq field.cf_name) ^ ",\n")) in List.iter - (gen_field ctx class_def class_name smart_class_name dot_name false class_def.cl_interface) + (gen_field ctx class_def class_name smart_class_name dot_name false (has_class_flag class_def CInterface)) class_def.cl_ordered_fields; List.iter - (gen_field ctx class_def class_name smart_class_name dot_name true class_def.cl_interface) statics_except_meta; + (gen_field ctx class_def class_name smart_class_name dot_name true (has_class_flag class_def CInterface)) statics_except_meta; output_cpp "\n"; if (List.length dynamic_functions > 0) then begin @@ -5944,12 +6057,14 @@ let generate_class_files baseCtx super_deps constructor_deps class_def inScripta output_cpp ("}\n"); end; - if (not class_def.cl_interface) && not nativeGen && not inlineContructor then - outputConstructor ctx output_cpp false; + if (not (has_class_flag class_def CInterface)) && not nativeGen && not inlineContructor && not (has_class_flag class_def CAbstract) then + outputConstructor ctx output_cpp false + else if nativeGen then + outputNativeConstructor ctx output_cpp false; (* Initialise non-static variables *) - if ( (not class_def.cl_interface) && (not nativeGen) ) then begin + if ( (not (has_class_flag class_def CInterface)) && (not nativeGen) ) then begin output_cpp (class_name ^ "::" ^ class_name ^ "()\n{\n"); List.iter (fun name -> output_cpp ("\t" ^ name ^ " = new __default_" ^ name ^ "(this);\n") @@ -6217,7 +6332,7 @@ let generate_class_files baseCtx super_deps constructor_deps class_def inScripta let generate_script_function isStatic field scriptName callName = match follow field.cf_type with | TFun (args,return_type) when not (is_data_member field) -> - let isTemplated = not isStatic && not class_def.cl_interface in + let isTemplated = not isStatic && not (has_class_flag class_def CInterface) in if isTemplated then output_cpp ("\ntemplate"); output_cpp ("\nstatic void CPPIA_CALL " ^ scriptName ^ "(::hx::CppiaCtx *ctx) {\n"); let ret = match cpp_type_of ctx return_type with TCppScalar("bool") -> "b" | _ -> script_signature return_type false in @@ -6225,7 +6340,7 @@ let generate_class_files baseCtx super_deps constructor_deps class_def inScripta let dump_call cast = - if class_def.cl_interface then begin + if (has_class_flag class_def CInterface) then begin output_cpp (class_name ^ "::" ^ callName ^ "(ctx->getThis()" ^ (if (List.length args) > 0 then "," else "")); end else if isStatic then output_cpp (class_name ^ "::" ^ callName ^ "(") @@ -6256,7 +6371,7 @@ let generate_class_files baseCtx super_deps constructor_deps class_def inScripta in - let newInteface = class_def.cl_interface in + let newInteface = (has_class_flag class_def CInterface) in if (scriptable && not nativeGen) then begin let delegate = "this->" in @@ -6284,7 +6399,7 @@ let generate_class_files baseCtx super_deps constructor_deps class_def inScripta output_cpp ("\tif (" ^ vtable ^ ") {\n" ); output_cpp ("\t\t::hx::CppiaCtx *__ctx = ::hx::CppiaCtx::getCurrent();\n" ); output_cpp ("\t\t::hx::AutoStack __as(__ctx);\n" ); - output_cpp ("\t\t__ctx->pushObject(" ^ (if class_def.cl_interface then "mDelegate.mPtr" else "this" ) ^");\n" ); + output_cpp ("\t\t__ctx->pushObject(" ^ (if (has_class_flag class_def CInterface) then "mDelegate.mPtr" else "this" ) ^");\n" ); List.iter (fun (name,opt, t ) -> output_cpp ("\t\t__ctx->push" ^ (script_type t opt) ^ "(" ^ (keyword_remap name) ^ ");\n" ); ) f_args; @@ -6292,7 +6407,7 @@ let generate_class_files baseCtx super_deps constructor_deps class_def inScripta output_cpp ("\t} else " ^ ret ); - if (class_def.cl_interface) then begin + if ((has_class_flag class_def CInterface)) then begin output_cpp (" " ^ delegate ^ "__Field(HX_CSTRING(\"" ^ field.cf_name ^ "\"), ::hx::paccNever)"); if (List.length names <= 5) then output_cpp ("->__run(" ^ (String.concat "," names) ^ ");") @@ -6303,7 +6418,7 @@ let generate_class_files baseCtx super_deps constructor_deps class_def inScripta if (return_type<>"void") then output_cpp "return null();"; output_cpp "}\n"; - if (class_def.cl_interface) && not dynamic_interface_closures then begin + if ((has_class_flag class_def CInterface)) && not dynamic_interface_closures then begin output_cpp (" Dynamic " ^ name ^ "_dyn() { return mDelegate->__Field(HX_CSTRING(\"" ^ field.cf_name ^ "\"), ::hx::paccNever); }\n\n"); end @@ -6328,7 +6443,7 @@ let generate_class_files baseCtx super_deps constructor_deps class_def inScripta List.exists (fun f -> f.cf_name="toString" && field_arg_count f <> 0) class_def.cl_ordered_fields in let super_string = if has_funky_toString then class_name ^ "::super" else class_name in output_cpp (" typedef "^ super_string ^" __superString;\n"); - if (class_def.cl_interface) then + if ((has_class_flag class_def CInterface)) then output_cpp (" HX_DEFINE_SCRIPTABLE_INTERFACE\n") else begin output_cpp (" HX_DEFINE_SCRIPTABLE(HX_ARR_LIST" ^ (string_of_int (List.length constructor_var_list) ) ^ ")\n"); @@ -6363,7 +6478,7 @@ let generate_class_files baseCtx super_deps constructor_deps class_def inScripta let dump_func f isStaticFlag = let s = try Hashtbl.find sigs f.cf_name with Not_found -> "v" in output_cpp (" ::hx::ScriptNamedFunction(\"" ^ f.cf_name ^ "\",__s_" ^ f.cf_name ^ ",\"" ^ s ^ "\", " ^ isStaticFlag ^ " " ); - let superCall = if (isStaticFlag="true") || class_def.cl_interface then "0" else ("__s_" ^ f.cf_name ^ "") in + let superCall = if (isStaticFlag="true") || (has_class_flag class_def CInterface) then "0" else ("__s_" ^ f.cf_name ^ "") in output_cpp ("HXCPP_CPPIA_SUPER_ARG(" ^ superCall ^")" ); output_cpp (" ),\n" ) in @@ -6388,7 +6503,7 @@ let generate_class_files baseCtx super_deps constructor_deps class_def inScripta let class_name_text = join_class_path class_path "." in (* Initialise static in boot function ... *) - if (not class_def.cl_interface && not nativeGen) then begin + if (not (has_class_flag class_def CInterface) && not nativeGen) && not (has_class_flag class_def CAbstract) then begin (* Remap the specialised "extern" classes back to the generic names *) output_cpp ("::hx::Class " ^ class_name ^ "::__mClass;\n\n"); if (scriptable) then begin @@ -6470,7 +6585,7 @@ let generate_class_files baseCtx super_deps constructor_deps class_def inScripta gen_close_namespace output_cpp class_path; - if class_def.cl_interface && has_meta_key class_def.cl_meta Meta.ObjcProtocol then begin + if (has_class_flag class_def CInterface) && has_meta_key class_def.cl_meta Meta.ObjcProtocol then begin let full_class_name = ("::" ^ (join_class_path_remap class_path "::") ) ^ "_obj" in let protocol = get_meta_string class_def.cl_meta Meta.ObjcProtocol in generate_protocol_delegate ctx class_def output_cpp; @@ -6504,9 +6619,9 @@ let generate_class_files baseCtx super_deps constructor_deps class_def inScripta let parent,super = match class_def.cl_super with | Some (klass,params) -> let name = (tcpp_to_string_suffix "_obj" (cpp_instance_type ctx klass params) ) in - (if class_def.cl_interface && nativeGen then "virtual " else "" ) ^ name, name - | None when nativeGen && class_def.cl_interface -> "virtual ::hx::NativeInterface", "::hx::NativeInterface" - | None when class_def.cl_interface -> "", "::hx::Object" + (if (has_class_flag class_def CInterface) && nativeGen then "virtual " else "" ) ^ name, name + | None when nativeGen && (has_class_flag class_def CInterface) -> "virtual ::hx::NativeInterface", "::hx::NativeInterface" + | None when (has_class_flag class_def CInterface) -> "", "::hx::Object" | None when nativeGen -> "", "" | None -> "::hx::Object", "::hx::Object" in @@ -6519,8 +6634,9 @@ let generate_class_files baseCtx super_deps constructor_deps class_def inScripta (* Include the real header file for the super class *) (match class_def.cl_super with | Some super -> - let super_path = (fst super).cl_path in - h_file#add_include super_path + let klass = fst super in + let include_file = get_meta_string_path klass.cl_meta Meta.Include in + h_file#add_include (if include_file="" then klass.cl_path else path_of_string include_file) | _ -> () ); (* And any interfaces ... *) @@ -6554,7 +6670,7 @@ let generate_class_files baseCtx super_deps constructor_deps class_def inScripta ) (List.filter (fun (t,_) -> is_native_gen_class t) class_def.cl_implements); in - if (class_def.cl_interface && not nativeGen) then begin + if ((has_class_flag class_def CInterface) && not nativeGen) then begin output_h ("class " ^ attribs ^ " " ^ class_name ^ " {\n"); output_h "\tpublic:\n"; output_h ("\t\ttypedef " ^ super ^ " super;\n"); @@ -6574,7 +6690,7 @@ let generate_class_files baseCtx super_deps constructor_deps class_def inScripta - if (not class_def.cl_interface && not nativeGen) then begin + if (not (has_class_flag class_def CInterface) && not nativeGen) then begin output_h ("\t\t" ^ class_name ^ "();\n"); output_h "\n\tpublic:\n"; output_h ("\t\tenum { _hx_ClassId = " ^ classIdTxt ^ " };\n\n"); @@ -6583,7 +6699,9 @@ let generate_class_files baseCtx super_deps constructor_deps class_def inScripta output_h ("\t\t\t{ return ::hx::Object::operator new(inSize,inContainer,inName); }\n" ); output_h ("\t\tinline void *operator new(size_t inSize, int extra)\n" ); output_h ("\t\t\t{ return ::hx::Object::operator new(inSize+extra," ^ isContainer ^ "," ^ gcName ^ "); }\n" ); - if inlineContructor then begin + if has_class_flag class_def CAbstract then + output_h "\n" + else if inlineContructor then begin output_h "\n"; outputConstructor ctx (fun str -> output_h ("\t\t" ^ str) ) true end else begin @@ -6652,6 +6770,7 @@ let generate_class_files baseCtx super_deps constructor_deps class_def inScripta end else if not nativeGen then begin output_h ("\t\tHX_DO_INTERFACE_RTTI;\n\n"); end else begin + outputNativeConstructor ctx output_h true; (* native interface *) ( ) end; @@ -6664,15 +6783,15 @@ let generate_class_files baseCtx super_deps constructor_deps class_def inScripta | _ -> ()); - List.iter (gen_member_def ctx class_def true class_def.cl_interface) (List.filter should_implement_field class_def.cl_ordered_statics); + List.iter (gen_member_def ctx class_def true (has_class_flag class_def CInterface)) (List.filter should_implement_field class_def.cl_ordered_statics); - if class_def.cl_interface then begin + if (has_class_flag class_def CInterface) then begin List.iter (fun (field,_,_) -> gen_member_def ctx class_def false true field) functions; end else begin List.iter (gen_member_def ctx class_def false false) (List.filter should_implement_field class_def.cl_ordered_fields); end; - if class_def.cl_interface && has_meta_key class_def.cl_meta Meta.ObjcProtocol then begin + if (has_class_flag class_def CInterface) && has_meta_key class_def.cl_meta Meta.ObjcProtocol then begin let protocol = get_meta_string class_def.cl_meta Meta.ObjcProtocol in output_h ("\t\tstatic id<" ^ protocol ^ "> _hx_toProtocol(Dynamic inImplementation);\n"); end; @@ -6689,7 +6808,7 @@ let generate_class_files baseCtx super_deps constructor_deps class_def inScripta in (* create header and cpp files *) - if not (nativeGen && class_def.cl_interface) then + if not (nativeGen && (has_class_flag class_def CInterface)) then generate_class_cpp (); generate_class_header () ;; @@ -6833,7 +6952,7 @@ let create_member_types common_ctx = let result = Hashtbl.create 0 in List.iter (fun object_def -> (match object_def with - | TClassDecl class_def when not class_def.cl_interface -> + | TClassDecl class_def when not (has_class_flag class_def CInterface) -> let rec add_override to_super = let class_name = (join_class_path to_super.cl_path ".") in List.iter (fun member -> Hashtbl.add result (class_name ^ "." ^ member.cf_name) "virtual " ) class_def.cl_ordered_fields; @@ -6851,13 +6970,13 @@ let create_super_dependencies common_ctx = let result = Hashtbl.create 0 in List.iter (fun object_def -> (match object_def with - | TClassDecl class_def when not class_def.cl_extern -> + | TClassDecl class_def when not (has_class_flag class_def CExtern) -> let deps = ref [] in (match class_def.cl_super with Some super -> - if not (fst super).cl_extern then + if not (has_class_flag (fst super) CExtern) then deps := ((fst super).cl_path) :: !deps | _ ->() ); - List.iter (fun imp -> if not (fst imp).cl_extern then deps := (fst imp).cl_path :: !deps) (real_non_native_interfaces class_def.cl_implements); + List.iter (fun imp -> if not (has_class_flag (fst imp) CExtern) then deps := (fst imp).cl_path :: !deps) (real_non_native_interfaces class_def.cl_implements); Hashtbl.add result class_def.cl_path !deps; | TEnumDecl enum_def when not enum_def.e_extern -> Hashtbl.add result enum_def.e_path []; @@ -6869,7 +6988,7 @@ let create_constructor_dependencies common_ctx = let result = Hashtbl.create 0 in List.iter (fun object_def -> (match object_def with - | TClassDecl class_def when not class_def.cl_extern -> + | TClassDecl class_def when not (has_class_flag class_def CExtern) -> (match class_def.cl_constructor with | Some func_def -> Hashtbl.add result class_def.cl_path func_def | _ -> () ) @@ -7361,7 +7480,7 @@ class script_writer ctx filename asciiOut = this#write ( (this#op IaFunction) ^ (this#staticText isStatic) ^ " " ^(this#boolText isDynamic) ^ " " ^(this#stringText funcName) ^ " "); this#write ((this#typeTextString "Void") ^ "0\n"); this#gen_expression fieldExpression - method func isStatic isDynamic funcName ret args isInterface fieldExpression = + method func isStatic isDynamic funcName ret args isInterface fieldExpression abstractPos = this#comment funcName; this#write ( (this#op IaFunction) ^ (this#staticText isStatic) ^ " " ^(this#boolText isDynamic) ^ " " ^(this#stringText funcName) ^ " "); this#write ((this#typeText ret) ^ (string_of_int (List.length args)) ^ " "); @@ -7382,7 +7501,12 @@ class script_writer ctx filename asciiOut = close() end else this#gen_expression e - | _ -> print_endline ("Missing function body for " ^ funcName ); + | _ -> + (* Abstract function - dummp implementation that (should) not get called *) + this#begin_expr; + this#wpos abstractPos; + this#writeOpLine IaReturn; + this#end_expr; end method var readAcc writeAcc isExtern isStatic name varType varExpr = this#write ( (this#op IaVar) ^ (this#staticText isStatic) ^ " " ^ (this#op readAcc) ^ (this#op writeAcc) ^ @@ -7402,7 +7526,7 @@ class script_writer ctx filename asciiOut = method writeVar v = this#ident v.v_name; this#wint v.v_id; - this#writeBool v.v_capture; + this#writeBool (has_var_flag v VCaptured); this#writeType v.v_type; method writeList prefix len = this#write (prefix ^" " ^ (string_of_int (len)) ^ "\n"); method wpos p = if debug then @@ -7672,6 +7796,7 @@ class script_writer ctx filename asciiOut = | Decrement, _ -> IaMinusMinusPost | Not, _ -> IaLogicNot | Neg, _ -> IaNeg + | Spread, _ -> die ~p:e.epos "Unexpected spread operator" __LOC__ | NegBits, _ -> IaBitNot ); this#gen_expression e; (* TODO - lval op-assign local/member/array *) @@ -7691,21 +7816,14 @@ class script_writer ctx filename asciiOut = this#checkCast tvar.v_type init false false); | TNew (clazz,params,arg_list) -> this#write ((this#op IaNew) ^ (this#typeText (TInst(clazz,params))) ^ (string_of_int (List.length arg_list)) ^ "\n"); - let rec matched_args clazz = match clazz.cl_constructor, clazz.cl_super with - | None, Some super -> matched_args (fst super) - | None, _ -> false - | Some ctr, _ -> - (match ctr.cf_type with - | TFun(args,_) -> - ( try ( - List.iter2 (fun (_,_,protoT) arg -> this#checkCast protoT arg false false) args arg_list; - true; ) - with Invalid_argument _ -> (*print_endline "Bad count?";*) false ) - | _ -> false - ) - in - if not (matched_args clazz) then - List.iter this#gen_expression arg_list; + (try + match OverloadResolution.maybe_resolve_constructor_overload clazz params arg_list with + | Some (_,{ cf_type = TFun(args,_) },_) -> + List.iter2 (fun (_,_,protoT) arg -> this#checkCast protoT arg false false) args arg_list; + | _ -> + raise (Invalid_argument "") + with Invalid_argument _ -> + List.iter this#gen_expression arg_list) | TReturn optval -> (match optval with | None -> this#writeOpLine IaReturn; @@ -7864,8 +7982,12 @@ class script_writer ctx filename asciiOut = | FuncEnumConstruct(enum,field) -> this#write ((this#op IaCreateEnum) ^ (this#enumText enum) ^ " " ^ (this#stringText field.ef_name) ^ argN ^ (this#commentOf field.ef_name) ^ "\n"); + | FuncSuperConstruct(TCppInst klass) when (is_native_gen_class klass) && (is_native_class klass) -> + abort "Unsupported super for native class constructor" expression.cpppos; | FuncSuperConstruct childType -> this#write ((this#op IaCallSuperNew) ^ (this#astType childType) ^ " " ^ argN ^ "\n"); + | FuncSuper(_,TCppInst(klass),_) when (is_native_gen_class klass) && (is_native_class klass) -> + abort "Unsupported super for native class method" expression.cpppos; | FuncSuper(_,objType,field) -> this#write ( (this#op IaCallSuper) ^ (this#astType objType) ^ " " ^ (this#stringText field.cf_name) ^ argN ^ (this#commentOf field.cf_name) ^ "\n"); @@ -8065,6 +8187,7 @@ class script_writer ctx filename asciiOut = | CppCode _ | CppFunctionAddress _ + | CppNewNative _ | CppDereference _ | CppAddressOf _ | CppFor _ @@ -8139,7 +8262,7 @@ let generate_script_class common_ctx script class_def = script#incClasses; let classText = (join_class_path class_def.cl_path ".") in script#comment ("Class " ^ classText); - script#writeOp (if class_def.cl_interface then IaInterface else IaClass ); + script#writeOp (if (has_class_flag class_def CInterface) then IaInterface else IaClass ); script#instName class_def; (match class_def.cl_super with | None -> script#ident "" @@ -8148,16 +8271,18 @@ let generate_script_class common_ctx script class_def = List.iter (fun(c,_) -> script#instName c) class_def.cl_implements; script#write "\n"; (* Looks like some map impl classes have their bodies discarded - not sure best way to filter *) - let non_dodgy_function field = - class_def.cl_interface || + let non_dodgy_function allow_empty field = + (has_class_flag class_def CInterface) || match field.cf_kind, field.cf_expr with | Var _, _ -> true | Method MethDynamic, _ -> true + | Method MethNormal, None when allow_empty -> true | Method _, Some _ -> true - | _ -> false + | _ -> + false in - let ordered_statics = List.filter non_dodgy_function class_def.cl_ordered_statics in - let ordered_fields = List.filter non_dodgy_function class_def.cl_ordered_fields in + let ordered_statics = List.filter (non_dodgy_function false) class_def.cl_ordered_statics in + let ordered_fields = List.filter (non_dodgy_function true) class_def.cl_ordered_fields in script#write ((string_of_int ( (List.length ordered_fields) + (List.length ordered_statics) + (match class_def.cl_constructor with Some _ -> 1 | _ -> 0 ) + @@ -8173,7 +8298,6 @@ let generate_script_class common_ctx script class_def = | AccNormal | AccCtor -> IaAccessNormal | AccNo -> IaAccessNot | AccNever -> IaAccessNot - | AccResolve -> IaAccessResolve | AccCall -> if ( (has_meta_key class_def.cl_meta Meta.NativeProperty) || (has_meta_key field.cf_meta Meta.NativeProperty) || (Common.defined common_ctx Define.ForceNativeProperty) ) @@ -8184,11 +8308,11 @@ let generate_script_class common_ctx script class_def = let isExtern = not (is_physical_field field) in script#var (mode_code v.v_read) (mode_code v.v_write) isExtern isStatic field.cf_name field.cf_type field.cf_expr | Method MethDynamic, TFun(args,ret) -> - script#func isStatic true field.cf_name ret args class_def.cl_interface field.cf_expr + script#func isStatic true field.cf_name ret args (has_class_flag class_def CInterface) field.cf_expr field.cf_pos | Method _, TFun(args,ret) when field.cf_name="new" -> - script#func true false "new" (TInst(class_def,[])) args false field.cf_expr + script#func true false "new" (TInst(class_def,[])) args false field.cf_expr field.cf_pos | Method _, TFun (args,ret) -> - script#func isStatic false field.cf_name ret args class_def.cl_interface field.cf_expr + script#func isStatic false field.cf_name ret args (has_class_flag class_def CInterface) field.cf_expr field.cf_pos | Method _, _ -> print_endline ("Unknown method type " ^ (join_class_path class_def.cl_path "." ) ^ "." ^field.cf_name ) in @@ -8236,7 +8360,7 @@ let generate_cppia ctx = List.iter (fun object_def -> (match object_def with - | TClassDecl class_def when class_def.cl_extern -> + | TClassDecl class_def when (has_class_flag class_def CExtern) -> () (*if (gen_externs) then gen_extern_class common_ctx class_def;*) | TClassDecl class_def -> let is_internal = is_internal_class class_def.cl_path in @@ -8336,7 +8460,7 @@ let generate_source ctx = nonboot_classes := class_def.cl_path :: !nonboot_classes; jobs := (fun () -> generate_class_files ctx super_deps constructor_deps class_def scriptable ) :: !jobs; let deps = generate_class_deps ctx class_def super_deps constructor_deps scriptable in - if not (class_def.cl_interface && (is_native_gen_class class_def)) then + if not ((has_class_flag class_def CInterface) && (is_native_gen_class class_def)) then exe_classes := (class_def.cl_path, deps, object_def) :: !exe_classes; end | TEnumDecl enum_def when enum_def.e_extern -> () @@ -8408,7 +8532,7 @@ let generate_source ctx = List.iter (fun (name,_,def) -> match def with | TClassDecl class_def -> - outline ((if class_def.cl_interface then "interface " else "class ") ^ (spath name) ); + outline ((if (has_class_flag class_def CInterface) then "interface " else "class ") ^ (spath name) ); | TEnumDecl enum_def -> out ("enum " ^ (spath name) ^ "\n"); | _ -> () diff --git a/src/generators/gencs.ml b/src/generators/gencs.ml index cc5633fd..bfbcb578 100644 --- a/src/generators/gencs.ml +++ b/src/generators/gencs.ml @@ -16,7 +16,7 @@ along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. *) - +open Extlib_leftovers open ReflectionCFs open Globals open Ast @@ -952,7 +952,8 @@ let generate con = | TInst( { cl_path = (["haxe"], "Int64") }, [] ) -> ti64 | TAbstract( { a_path = [],"Class" }, _ ) | TAbstract( { a_path = [],"Enum" }, _ ) - | TAbstract( { a_path = ["haxe";"extern"],"Rest" }, _ ) + | TAbstract( { a_path = (["haxe"]),"Rest" }, _ ) + | TType( { t_path = (["haxe";"extern"]),"Rest" }, _ ) | TInst( { cl_path = ([], "Class") }, _ ) | TInst( { cl_path = ([], "Enum") }, _ ) -> TInst(ttype,[]) | TInst( ({ cl_kind = KTypeParameter _ } as cl), _ ) when erase_generics && not (Meta.has Meta.NativeGeneric cl.cl_meta) -> @@ -1223,15 +1224,15 @@ let generate con = in let is_extern_prop t name = match follow (run_follow gen t), field_access gen t name with - | TInst({ cl_interface = true; cl_extern = true } as cl, _), FNotFound -> + | TInst(cl, _), FNotFound when (has_class_flag cl CExtern) && (has_class_flag cl CInterface) -> not (is_hxgen (TClassDecl cl)) | _, FClassField(_,_,decl,v,_,t,_) -> - not (Type.is_physical_field v) && (Meta.has Meta.Property v.cf_meta || (decl.cl_extern && not (is_hxgen (TClassDecl decl)))) + not (Type.is_physical_field v) && (Meta.has Meta.Property v.cf_meta || ((has_class_flag decl CExtern) && not (is_hxgen (TClassDecl decl)))) | _ -> false in let is_event t name = match follow (run_follow gen t), field_access gen t name with - | TInst({ cl_interface = true; cl_extern = true } as cl, _), FNotFound -> + | TInst(cl, _), FNotFound when (has_class_flag cl CExtern) && (has_class_flag cl CInterface) -> not (is_hxgen (TClassDecl cl)) | _, FClassField(_,_,decl,v,_,_,_) -> Meta.has Meta.Event v.cf_meta @@ -1368,8 +1369,25 @@ let generate con = | _ -> () *) | TFloat s -> - write w s; - (if String.get s (String.length s - 1) = '.' then write w "0"); + let len = String.length s in + let rec loop i prev_c = + if i >= len then begin + write w s; + if prev_c = '.' then write w "0" + end else begin + let c = String.unsafe_get s i in + if (c = 'e' || c = 'E') && prev_c = '.' then + let first = String.sub s 0 i in + let second = String.sub s i (len - i) in + write w first; + write w "0"; + write w second + else + loop (i + 1) c + end + in + loop 0 '#' + (*match real_type e.etype with | TType( { t_path = ([], "Single") }, [] ) -> write w "f" | _ -> () @@ -1417,7 +1435,7 @@ let generate con = (match mt with | TClassDecl { cl_path = (["haxe"], "Int64") } -> write w ("global::" ^ module_s mt) | TClassDecl { cl_path = (["haxe"], "Int32") } -> write w ("global::" ^ module_s mt) - | TClassDecl { cl_interface = true } -> + | TClassDecl c when (has_class_flag c CInterface) -> write w ("global::" ^ module_s mt); write w "__Statics_"; | TClassDecl cl -> write w (t_s (TInst(cl, List.map (fun _ -> t_empty) cl.cl_params))) @@ -1489,6 +1507,8 @@ let generate con = write w " as "; write w (t_s e.etype); write w " )"; + | TCall({ eexpr = TField (_, FStatic ({ cl_path = ["cs"],"Syntax" }, { cf_name = meth })) }, args) -> + gen_syntax meth args e.epos | TCall ({ eexpr = TIdent "__cs__" }, [ { eexpr = TConst(TString(s)) } ] ) -> write w s | TCall ({ eexpr = TIdent "__cs__" }, { eexpr = TConst(TString(s)) } :: tl ) -> @@ -1620,6 +1640,8 @@ let generate con = (match flag with | Ast.Prefix -> write w ( " " ^ (Ast.s_unop op) ^ " " ); expr_s w e | Ast.Postfix -> expr_s w e; write w (Ast.s_unop op)) + | TUnop (Spread, Prefix, e) -> + expr_s w e | TUnop (op, flag, e) -> (match flag with | Ast.Prefix -> write w ( " " ^ (Ast.s_unop op) ^ " (" ); expr_s w e; write w ") " @@ -1742,6 +1764,8 @@ let generate con = | TContinue -> write w "continue" | TThrow { eexpr = TIdent "__rethrow__" } -> write w "throw" + | TThrow { eexpr = TLocal(v) } when (has_var_flag v VCaught) -> + write w "throw"; | TThrow e -> write w "throw "; expr_s w e @@ -1767,7 +1791,40 @@ let generate con = | TEnumParameter _ -> write w "[ enum parameter not supported ]"; if !strict_mode then die "" __LOC__ | TEnumIndex _ -> write w "[ enum index not supported ]"; if !strict_mode then die "" __LOC__ | TIdent s -> write w "[ ident not supported ]"; if !strict_mode then die "" __LOC__ - ) + ) + and gen_syntax meth args pos = + match meth, args with + | "code", code :: args -> + let code, code_pos = + match code.eexpr with + | TConst (TString s) -> s, code.epos + | _ -> abort "The `code` argument for cs.Syntax.code must be a string constant" code.epos + in + begin + let rec reveal_expr expr = + match expr.eexpr with + | TCast (e, _) | TMeta (_, e) -> reveal_expr e + | _ -> expr + in + let args = List.map + (fun arg -> + match (reveal_expr arg).eexpr with + | TIf _ | TBinop _ | TUnop _ -> { arg with eexpr = TParenthesis arg } + | _ -> arg + ) + args + in + Codegen.interpolate_code gen.gcon code args (write w) (expr_s w) code_pos + end + | "plainCode", [code] -> + let code = + match code.eexpr with + | TConst (TString s) -> s + | _ -> abort "The `code` argument for cs.Syntax.plainCode must be a string constant" code.epos + in + write w (String.concat "\n" (ExtString.String.nsplit code "\r\n")) + | _ -> + abort (Printf.sprintf "Unknown cs.Syntax method `%s` with %d arguments" meth (List.length args)) pos and do_call w e el = let params, el = extract_tparams [] el in let params = List.rev params in @@ -1938,6 +1995,7 @@ let generate con = | TAbstract ({ a_path = (["cs"], "Ref") },[t]) -> "ref " ^ t_s t | TType ({ t_path = (["cs"], "Out") }, [t]) | TAbstract ({ a_path = (["cs"], "Out") },[t]) -> "out " ^ t_s t + | _ when ExtType.is_rest (Type.follow t) -> "params " ^ (t_s (Abstract.follow_with_abstracts t)) | t -> t_s t in let c = contents w in @@ -1972,12 +2030,12 @@ let generate con = acc (* non-sealed class *) - | TInst ({ cl_interface = false; cl_final = false},_) -> + | TInst (c,_) when not (has_class_flag c CFinal) && not (has_class_flag c CInterface) -> base_class_constraints := (CsConstraint (t_s t)) :: !base_class_constraints; acc; (* interface *) - | TInst ({ cl_interface = true}, _) -> + | TInst (c, _) when (has_class_flag c CInterface) -> (CsConstraint (t_s t)) :: acc (* cs constraints *) @@ -2047,7 +2105,7 @@ let generate con = in let rec gen_event w is_static cl (event,t,custom,add,remove) = - let is_interface = cl.cl_interface in + let is_interface = (has_class_flag cl CInterface) in let visibility = if is_interface then "" else "public" in let visibility, modifiers = get_fun_modifiers event.cf_meta visibility ["event"] in let v_n = if is_static then "static" else "" in @@ -2068,7 +2126,7 @@ let generate con = let rec gen_prop w is_static cl is_final (prop,t,get,set) = gen_attributes w prop.cf_meta; - let is_interface = cl.cl_interface in + let is_interface = (has_class_flag cl CInterface) in let fn_is_final = function | None -> true | Some ({ cf_kind = Method mkind } as m) -> @@ -2078,7 +2136,7 @@ let generate con = let is_virtual = not (is_interface || is_final || (has_class_field_flag prop CfFinal) || fn_is_final get || fn_is_final set) in let fn_is_override = function - | Some cf -> List.memq cf cl.cl_overrides + | Some cf -> has_class_field_flag cf CfOverride | None -> false in let is_override = fn_is_override get || fn_is_override set in @@ -2156,7 +2214,7 @@ let generate con = let rec gen_class_field w ?(is_overload=false) is_static cl is_final cf = gen_attributes w cf.cf_meta; - let is_interface = cl.cl_interface in + let is_interface = (has_class_flag cl CInterface) in let name, is_new, is_explicit_iface = match cf.cf_name with | "new" -> cf.cf_name, true, false | name when String.contains name '.' -> @@ -2212,7 +2270,7 @@ let generate con = ); end (* TODO see how (get,set) variable handle when they are interfaces *) | Method _ when not (Type.is_physical_field cf) || (match cl.cl_kind, cf.cf_expr with | KAbstractImpl _, None -> true | _ -> false) -> - List.iter (fun cf -> if cl.cl_interface || cf.cf_expr <> None then + List.iter (fun cf -> if (has_class_flag cl CInterface) || cf.cf_expr <> None then gen_class_field w ~is_overload:true is_static cl (has_class_field_flag cf CfFinal) cf ) cf.cf_overloads | Var _ | Method MethDynamic -> () @@ -2232,7 +2290,7 @@ let generate con = gen.gcon.error "The body of a zero argument constructor of a struct should be empty" e.epos | _ -> ()); List.iter (fun cf -> - if cl.cl_interface || cf.cf_expr <> None then + if (has_class_flag cl CInterface) || cf.cf_expr <> None then gen_class_field w ~is_overload:true is_static cl (has_class_field_flag cf CfFinal) cf ) cf.cf_overloads; | Method mkind -> @@ -2244,12 +2302,12 @@ let generate con = | overloads -> overloads in List.iter (fun cf -> - if cl.cl_interface || cf.cf_expr <> None then + if (has_class_flag cl CInterface) || (has_class_flag cl CAbstract) || cf.cf_expr <> None then gen_class_field w ~is_overload:true is_static cl (has_class_field_flag cf CfFinal) cf ) overloads; let is_virtual = not is_final && match mkind with | MethInline -> false | _ when not is_new -> true | _ -> false in let is_virtual = if not is_virtual || (has_class_field_flag cf CfFinal) then false else is_virtual in - let is_override = List.memq cf cl.cl_overrides in + let is_override = has_class_field_flag cf CfOverride in let is_override = is_override || match cf.cf_name, follow cf.cf_type with | "Equals", TFun([_,_,targ], tret) -> (match follow targ, follow tret with @@ -2260,14 +2318,16 @@ let generate con = in let is_override = if Meta.has (Meta.Custom "?prop_impl") cf.cf_meta then false else is_override in - let is_virtual = is_virtual && not cl.cl_final && not (is_interface) in + let is_abstract = has_class_field_flag cf CfAbstract in + let is_virtual = is_virtual && not (has_class_flag cl CFinal) && not (is_interface) && not is_abstract in let visibility = if is_interface then "" else "public" in let visibility, modifiers = get_fun_modifiers cf.cf_meta visibility [] in let modifiers = modifiers @ modf in + let modifiers = if is_abstract then "abstract" :: modifiers else modifiers in let visibility, is_virtual = if is_explicit_iface then "",false else if visibility = "private" then "private",false else visibility, is_virtual in let v_n = if is_static then "static" else if is_override && not is_interface then "override" else if is_virtual then "virtual" else "" in - let cf_type = if is_override && not is_overload && not (Meta.has Meta.Overload cf.cf_meta) then match field_access gen (TInst(cl, List.map snd cl.cl_params)) cf.cf_name with | FClassField(_,_,_,_,_,actual_t,_) -> actual_t | _ -> die "" __LOC__ else cf.cf_type in + let cf_type = if is_override && not is_overload && not (has_class_field_flag cf CfOverload) then match field_access gen (TInst(cl, List.map snd cl.cl_params)) cf.cf_name with | FClassField(_,_,_,_,_,actual_t,_) -> actual_t | _ -> die "" __LOC__ else cf.cf_type in let ret_type, args = match follow cf_type with | TFun (strbtl, t) -> (t, strbtl) | _ -> die "" __LOC__ in gen_nocompletion w cf.cf_meta; @@ -2282,7 +2342,7 @@ let generate con = | _ -> print w "%s(%s)%s" (params) (String.concat ", " (List.map (fun (name, _, t) -> sprintf "%s %s" (argt_s t) (change_id name)) args)) (params_ext) ); - if is_interface then + if is_interface || is_abstract then write w ";" else begin write w " "; @@ -2440,7 +2500,7 @@ let generate con = newline w ) cl.cl_implements with | Not_found -> ()); - if cl.cl_interface && is_hxgen (TClassDecl cl) && is_some cl.cl_array_access then begin + if (has_class_flag cl CInterface) && is_hxgen (TClassDecl cl) && is_some cl.cl_array_access then begin let changed_t = apply_params cl.cl_params (List.map (fun _ -> t_dynamic) cl.cl_params) (get cl.cl_array_access) in print w "%s this[int key]" (t_s (run_follow gen changed_t)); begin_block w; @@ -2453,9 +2513,9 @@ let generate con = newline w end; (try - if cl.cl_interface then raise Not_found; + if (has_class_flag cl CInterface) then raise Not_found; let cf = PMap.find "toString" cl.cl_fields in - (if List.exists (fun c -> c.cf_name = "toString") cl.cl_overrides then raise Not_found); + (if has_class_field_flag cf CfOverride then raise Not_found); (match cf.cf_type with | TFun([], ret) -> (match real_type ret with @@ -2473,9 +2533,9 @@ let generate con = ) with | Not_found -> ()); (try - if cl.cl_interface then raise Not_found; + if (has_class_flag cl CInterface) then raise Not_found; let cf = PMap.find "finalize" cl.cl_fields in - (if List.exists (fun c -> c.cf_name = "finalize") cl.cl_overrides then raise Not_found); + (if has_class_field_flag cf CfOverride then raise Not_found); (match cf.cf_type with | TFun([], ret) -> (match real_type ret with @@ -2584,7 +2644,7 @@ let generate con = let main_expr = match gen.gentry_point with - | Some (_,({ cl_path = (_,"Main") } as cl_main),expr) when cl == cl_main && not cl.cl_interface -> + | Some (_,({ cl_path = (_,"Main") } as cl_main),expr) when cl == cl_main && not (has_class_flag cl CInterface) -> (* for cases where the main class is called Main, there will be a problem with creating the entry point there. In this special case, a special entry point class will be created @@ -2600,15 +2660,17 @@ let generate con = end_block w; newline w; None - | Some (_, cl_main,expr) when cl == cl_main && not cl.cl_interface -> Some expr + | Some (_, cl_main,expr) when cl == cl_main && not (has_class_flag cl CInterface) -> Some expr | _ -> None in - let clt, access, modifiers = get_class_modifiers cl.cl_meta (if cl.cl_interface then "interface" else "class") "public" [] in - let modifiers = if cl.cl_final then "sealed" :: modifiers else modifiers in - let is_final = clt = "struct" || cl.cl_final in + let clt, access, modifiers = get_class_modifiers cl.cl_meta (if (has_class_flag cl CInterface) then "interface" else "class") "public" [] in + let modifiers = if is_module_fields_class cl then "static" :: modifiers else if (has_class_flag cl CFinal) then "sealed" :: modifiers else modifiers in + let is_final = clt = "struct" || (has_class_flag cl CFinal) in let modifiers = [access] @ modifiers in + let is_abstract = has_class_flag cl CAbstract in + let modifiers = if is_abstract then "abstract" :: modifiers else modifiers in print w "%s %s %s" (String.concat " " modifiers) clt (change_clname (snd cl.cl_path)); (* type parameters *) let params, params_ext = get_string_params cl cl.cl_params in @@ -2711,7 +2773,7 @@ let generate con = | _ -> false in - let interf = cl.cl_interface in + let interf = (has_class_flag cl CInterface) in (* get all functions that are getters/setters *) let nonprops = List.filter (function | cf when String.starts_with cf.cf_name "get_" -> (try @@ -2754,7 +2816,7 @@ let generate con = let ev, t, custom, add, remove = !r in match add, remove with | Some add, Some remove -> - if custom && not cl.cl_interface then + if custom && not (has_class_flag cl CInterface) then nonprops := add :: remove :: !nonprops | _ -> die "" __LOC__ (* shouldn't happen because Filters.check_cs_events makes sure methods are present *) ) events; @@ -2768,7 +2830,7 @@ let generate con = let fevents, fprops, fnonprops = partition cl cl.cl_ordered_fields in let sevents, sprops, snonprops = partition cl cl.cl_ordered_statics in (if is_some cl.cl_constructor then gen_class_field w false cl is_final (get cl.cl_constructor)); - if not cl.cl_interface then begin + if not (has_class_flag cl CInterface) then begin (* we don't want to generate properties for abstract implementation classes, because they don't have object to work with *) List.iter (gen_event w true cl) sevents; if (match cl.cl_kind with KAbstractImpl _ -> false | _ -> true) then List.iter (gen_prop w true cl is_final) sprops; @@ -2779,10 +2841,12 @@ let generate con = List.iter (gen_class_field w false cl is_final) fnonprops; check_special_behaviors w cl; end_block w; - if cl.cl_interface && cl.cl_ordered_statics <> [] then begin + if (has_class_flag cl CInterface) && cl.cl_ordered_statics <> [] then begin print w "public class %s__Statics_" (snd cl.cl_path); begin_block w; - List.iter (gen_class_field w true { cl with cl_interface = false } is_final) cl.cl_ordered_statics; + remove_class_flag cl CInterface; + List.iter (gen_class_field w true cl is_final) cl.cl_ordered_statics; + add_class_flag cl CInterface; end_block w end; if should_close then end_block w @@ -2815,7 +2879,7 @@ let generate con = reset_temps(); match md_tp with | TClassDecl cl -> - if not cl.cl_extern then begin + if not (has_class_flag cl CExtern) then begin (if requires_root then write w "using haxe.root;\n"; newline w;); (if (Meta.has Meta.CsUsing cl.cl_meta) then @@ -2838,7 +2902,7 @@ let generate con = newline w; newline w end; - (not cl.cl_extern) + (not (has_class_flag cl CExtern)) | TEnumDecl e -> if not e.e_extern && not (Meta.has Meta.Class e.e_meta) then begin (if requires_root then write w "using haxe.root;\n"; newline w;); @@ -3124,7 +3188,7 @@ let generate con = List.iter (fun cl -> List.iter (fun cf -> - if cf.cf_name = dynamic_name then cl.cl_overrides <- cf :: cl.cl_overrides + if cf.cf_name = dynamic_name then add_class_field_flag cf CfOverride ) cl.cl_ordered_fields ) [closure_cl; varargs_cl]; @@ -3365,7 +3429,7 @@ let generate con = output_string f v; close_out f; - out_files := (Path.UniqueKey.create full_path) :: !out_files + out_files := (gen.gcon.file_keys#get full_path) :: !out_files ) gen.gcon.resources; end; (* add resources array *) @@ -3405,11 +3469,11 @@ let generate con = if not (List.exists (function net_lib -> net_lib#get_name = name) haxe_libs) then gen.gcon.warning ("The -net-lib with path " ^ name ^ " contains a Haxe-generated assembly, however it wasn't compiled with `-dce no`. Recompilation with `-dce no` is recommended") null_pos; (* it has; in this case, we need to add the used fields on each __init__ *) - flookup_cl.cl_extern <- true; + add_class_flag flookup_cl CExtern; let hashs_by_path = Hashtbl.create !nhash in Hashtbl.iter (fun (path,i) s -> Hashtbl.add hashs_by_path path (i,s)) rcf_ctx.rcf_hash_paths; Hashtbl.iter (fun _ md -> match md with - | TClassDecl ({ cl_extern = false; cl_interface = false } as c) -> (try + | TClassDecl c when not (has_class_flag c CExtern) && not (has_class_flag c CInterface) -> (try let all = Hashtbl.find_all hashs_by_path c.cl_path in let all = List.map (fun (i,s) -> normalize_i i, s) all in let all = List.sort (fun (i,s) (i2,s2) -> compare i i2) all in @@ -3443,7 +3507,7 @@ let generate con = if Common.defined gen.gcon Define.DllImport then begin Hashtbl.iter (fun _ md -> match md with - | TClassDecl ({ cl_extern = false } as c) -> (try + | TClassDecl c when not (has_class_flag c CExtern) -> (try let extra = match c.cl_params with | _ :: _ when not erase_generics -> "_" ^ string_of_int (List.length c.cl_params) | _ -> "" @@ -3456,7 +3520,7 @@ let generate con = let path = (pack, snd c.cl_path ^ extra) in ignore (List.find (function net_lib -> is_some (net_lib#lookup path)) haxe_libs); - c.cl_extern <- true; + add_class_flag c CExtern; with | Not_found -> ()) | _ -> ()) gen.gtypes end; @@ -3477,13 +3541,21 @@ let generate con = ) gen.gmodules; if not (Common.defined gen.gcon Define.KeepOldOutput) then - clean_files (gen.gcon.file ^ "/src") !out_files gen.gcon.verbose; + clean_files gen (gen.gcon.file ^ "/src") !out_files gen.gcon.verbose; dump_descriptor gen ("hxcs_build.txt") s_type_path module_s; if ( not (Common.defined gen.gcon Define.NoCompilation) ) then begin let old_dir = Sys.getcwd() in Sys.chdir gen.gcon.file; let cmd = "haxelib run hxcs hxcs_build.txt --haxe-version " ^ (string_of_int gen.gcon.version) ^ " --feature-level 1" in + let cmd = + match gen.gentry_point with + | Some (name,_,_) -> + let name = if gen.gcon.debug then name ^ "-Debug" else name in + cmd ^ " --out " ^ gen.gcon.file ^ "/bin/" ^ name + | _ -> + cmd + in print_endline cmd; if gen.gcon.run_command cmd <> 0 then failwith "Build failed"; Sys.chdir old_dir; diff --git a/src/generators/genhl.ml b/src/generators/genhl.ml index 29a70f8d..2ee2c332 100644 --- a/src/generators/genhl.ml +++ b/src/generators/genhl.ml @@ -19,6 +19,7 @@ * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER * DEALINGS IN THE SOFTWARE. *) +open Extlib_leftovers open Unix open Globals open Ast @@ -433,7 +434,7 @@ let rec to_type ?tref ctx t = | [] -> HDyn | t :: tl -> match follow (apply_params c.cl_params pl t) with - | TInst ({cl_interface=false},_) as t -> to_type ?tref ctx t + | TInst (c,_) as t when not (has_class_flag c CInterface) -> to_type ?tref ctx t | _ -> loop tl in loop tl @@ -478,7 +479,7 @@ and resolve_class ctx c pl statics = if statics then ctx.array_impl.abase else array_class ctx (to_type ctx t) | ([],"Array"), [] -> die "" __LOC__ - | _, _ when c.cl_extern -> + | _, _ when (has_class_flag c CExtern) -> not_supported() | _ -> c @@ -548,11 +549,11 @@ and real_type ctx e = to_type ctx (loop e) and class_type ?(tref=None) ctx c pl statics = - let c = if c.cl_extern then resolve_class ctx c pl statics else c in + let c = if (has_class_flag c CExtern) then resolve_class ctx c pl statics else c in let key_path = (if statics then "$" ^ snd c.cl_path else snd c.cl_path) :: fst c.cl_path in try PMap.find key_path ctx.cached_types - with Not_found when c.cl_interface && not statics -> + with Not_found when (has_class_flag c CInterface) && not statics -> let vp = { vfields = [||]; vindex = PMap.empty; @@ -626,7 +627,7 @@ and class_type ?(tref=None) ctx c pl statics = | Method m when m <> MethDynamic && not statics -> let g = alloc_fid ctx c f in p.pfunctions <- PMap.add f.cf_name g p.pfunctions; - let virt = if List.exists (fun ff -> ff.cf_name = f.cf_name) c.cl_overrides then + let virt = if has_class_field_flag f CfOverride then let vid = (try -(fst (get_index f.cf_name p))-1 with Not_found -> die "" __LOC__) in DynArray.set virtuals vid g; Some vid @@ -640,7 +641,7 @@ and class_type ?(tref=None) ctx c pl statics = in DynArray.add pa { fname = f.cf_name; fid = alloc_string ctx f.cf_name; fmethod = g; fvirtual = virt; }; None - | Method MethDynamic when List.exists (fun ff -> ff.cf_name = f.cf_name) c.cl_overrides -> + | Method MethDynamic when has_class_field_flag f CfOverride -> Some (try fst (get_index f.cf_name p) with Not_found -> die "" __LOC__) | _ -> let fid = add_field f.cf_name (fun() -> to_type ctx f.cf_type) in @@ -663,7 +664,7 @@ and class_type ?(tref=None) ctx c pl statics = (* check toString *) (try let cf = PMap.find "toString" c.cl_fields in - if List.memq cf c.cl_overrides || PMap.mem "__string" c.cl_fields || not (is_to_string cf.cf_type) then raise Not_found; + if has_class_field_flag cf CfOverride || PMap.mem "__string" c.cl_fields || not (is_to_string cf.cf_type) then raise Not_found; DynArray.add pa { fname = "__string"; fid = alloc_string ctx "__string"; fmethod = alloc_fun_path ctx c.cl_path "__string"; fvirtual = None; } with Not_found -> ()); @@ -966,7 +967,7 @@ let common_type ctx e1 e2 for_eq p = loop t1 t2 let captured_index ctx v = - if not v.v_capture then None else try Some (PMap.find v.v_id ctx.m.mcaptured.c_map) with Not_found -> None + if not (has_var_flag v VCaptured) then None else try Some (PMap.find v.v_id ctx.m.mcaptured.c_map) with Not_found -> None let real_name v = let rec loop = function @@ -1311,7 +1312,7 @@ and object_access ctx eobj t f = and direct_method_call ctx c f ethis = if (match f.cf_kind with Method m -> m = MethDynamic | Var _ -> true) then false - else if c.cl_interface then + else if (has_class_flag c CInterface) then false else if (match c.cl_kind with KTypeParameter _ -> true | _ -> false) then false @@ -1344,7 +1345,7 @@ and get_access ctx e = | TAbstract (a,pl) -> loop (Abstract.get_underlying_type a pl) | _ -> abort (s_type (print_context()) ethis.etype ^ " hl type should be interface") ethis.epos in - let cdef, pl = if cdef.cl_interface then loop ethis.etype else cdef,pl in + let cdef, pl = if (has_class_flag cdef CInterface) then loop ethis.etype else cdef,pl in object_access ctx ethis (class_type ctx cdef pl false) f | (FAnon f | FClosure(None,f)), _ -> object_access ctx ethis (to_type ctx ethis.etype) f @@ -2496,6 +2497,8 @@ and eval_expr ctx e = let r = eval_to ctx v t in op ctx (ONeg (tmp,r)); tmp + | TUnop (Spread,_,_) -> + die ~p:e.epos "Unexpected spread operator" __LOC__ | TUnop (NegBits,_,v) -> let t = to_type ctx e.etype in let tmp = alloc_tmp ctx t in @@ -2907,7 +2910,7 @@ and eval_expr ctx e = if safe_cast (rtype ctx re) t then op ctx (OMov (rt,re)) else (match Abstract.follow_with_abstracts e.etype with - | TInst({ cl_interface = true } as c,_) -> + | TInst(c,_) when (has_class_flag c CInterface) -> hold ctx re; let c = eval_to ctx { eexpr = TTypeExpr(TClassDecl c); epos = e.epos; etype = t_dynamic } (class_type ctx ctx.base_type [] false) in hold ctx c; @@ -3040,10 +3043,10 @@ and build_capture_vars ctx f = let used_vars = ref PMap.empty in (* get all captured vars in scope, ignore vars that are declared *) let decl_var v = - if v.v_capture then ignored_vars := PMap.add v.v_id () !ignored_vars + if has_var_flag v VCaptured then ignored_vars := PMap.add v.v_id () !ignored_vars in let use_var v = - if v.v_capture then used_vars := PMap.add v.v_id v !used_vars + if has_var_flag v VCaptured then used_vars := PMap.add v.v_id v !used_vars in let rec loop e = (match e.eexpr with @@ -3358,8 +3361,26 @@ let rec generate_member ctx c f = | _ -> () ) c.cl_ordered_fields; ) in - ignore(make_fun ?gen_content ctx (s_type_path c.cl_path,f.cf_name) (alloc_fid ctx c f) (match f.cf_expr with Some { eexpr = TFunction f } -> f | _ -> abort "Missing function body" f.cf_pos) (Some c) None); - if f.cf_name = "toString" && not (List.memq f c.cl_overrides) && not (PMap.mem "__string" c.cl_fields) && is_to_string f.cf_type then begin + let ff = match f.cf_expr with + | Some { eexpr = TFunction f } -> f + | None when has_class_field_flag f CfAbstract -> + let tl,tr = match follow f.cf_type with + | TFun(tl,tr) -> tl,tr + | _ -> die "" __LOC__ + in + let args = List.map (fun (n,_,t) -> + let v = Type.alloc_var VGenerated n t null_pos in + (v,None) + ) tl in + { + tf_args = args; + tf_type = tr; + tf_expr = mk (TThrow (mk (TConst TNull) t_dynamic null_pos)) t_dynamic null_pos; + } + | _ -> abort "Missing function body" f.cf_pos + in + ignore(make_fun ?gen_content ctx (s_type_path c.cl_path,f.cf_name) (alloc_fid ctx c f) ff (Some c) None); + if f.cf_name = "toString" && not (has_class_field_flag f CfOverride) && not (PMap.mem "__string" c.cl_fields) && is_to_string f.cf_type then begin let p = f.cf_pos in (* function __string() return this.toString().bytes *) let ethis = mk (TConst TThis) (TInst (c,List.map snd c.cl_params)) p in @@ -3371,9 +3392,9 @@ let rec generate_member ctx c f = let generate_type ctx t = match t with - | TClassDecl { cl_interface = true }-> + | TClassDecl c when (has_class_flag c CInterface) -> () - | TClassDecl c when c.cl_extern -> + | TClassDecl c when (has_class_flag c CExtern) -> List.iter (fun f -> List.iter (fun (name,args,pos) -> match name with @@ -3416,7 +3437,7 @@ let generate_static_init ctx types main = (* init class values *) List.iter (fun t -> match t with - | TClassDecl c when not c.cl_extern && not (is_array_class (s_type_path c.cl_path) && snd c.cl_path <> "ArrayDyn") && c != ctx.core_type && c != ctx.core_enum -> + | TClassDecl c when not (has_class_flag c CExtern) && not (is_array_class (s_type_path c.cl_path) && snd c.cl_path <> "ArrayDyn") && c != ctx.core_type && c != ctx.core_enum -> let path = if c == ctx.array_impl.abase then [],"Array" else if c == ctx.base_class then [],"Class" else c.cl_path in @@ -3476,13 +3497,13 @@ let generate_static_init ctx types main = List.exists (fun (i,_) -> i == c || lookup i) cv.cl_implements in let check = function - | TClassDecl c when c.cl_interface = false && not c.cl_extern -> if lookup c then classes := c :: !classes + | TClassDecl c when (has_class_flag c CInterface) = false && not (has_class_flag c CExtern) -> if lookup c then classes := c :: !classes | _ -> () in List.iter check ctx.com.types; !classes in - if c.cl_interface then begin + if (has_class_flag c CInterface) then begin let l = gather_implements() in let ra = alloc_tmp ctx HArray in let rt = alloc_tmp ctx HType in @@ -3589,7 +3610,7 @@ let generate_static_init ctx types main = List.iter (fun t -> (match t with TClassDecl { cl_init = Some e } -> init_exprs := e :: !init_exprs | _ -> ()); match t with - | TClassDecl c when not c.cl_extern -> + | TClassDecl c when not (has_class_flag c CExtern) -> List.iter (fun f -> match f.cf_kind, f.cf_expr with | Var _, Some e -> @@ -3993,7 +4014,7 @@ let add_types ctx types = List.iter (fun t -> match t with | TClassDecl ({ cl_path = ["hl";"types"], ("BytesIterator"|"BytesKeyValueIterator"|"ArrayBytes") } as c) -> - c.cl_extern <- true + add_class_flag c CExtern | TClassDecl c -> let rec loop p f = match p with @@ -4003,7 +4024,7 @@ let add_types ctx types = | _ -> false in - if not ctx.is_macro then List.iter (fun f -> ignore(loop c.cl_super f)) c.cl_overrides; + if not ctx.is_macro then List.iter (fun f -> if has_class_field_flag f CfOverride then ignore(loop c.cl_super f)) c.cl_ordered_fields; List.iter (fun (m,args,p) -> if m = Meta.HlNative then let lib, prefix = (match args with @@ -4049,8 +4070,30 @@ let check ctx = if not (Hashtbl.mem ctx.defined_funs fid) then failwith (Printf.sprintf "Unresolved method %s:%s(@%d)" (s_type_path p) s fid) ) ctx.cfids.map +let make_context_sign com = + let mhash = Hashtbl.create 0 in + List.iter (fun t -> + let mt = t_infos t in + let mid = mt.mt_module.m_id in + Hashtbl.add mhash mid true + ) com.types; + let data = Marshal.to_string mhash [No_sharing] in + Digest.to_hex (Digest.string data) + +let prev_sign = ref "" and prev_data = ref "" + let generate com = let dump = Common.defined com Define.Dump in + let hl_check = Common.raw_defined com "hl-check" in + + let sign = make_context_sign com in + if sign = !prev_sign && not dump && not hl_check then begin + (* reuse previously generated data *) + let ch = open_out_bin com.file in + output_string ch !prev_data; + close_out ch; + end else + let ctx = create_context com false dump in add_types ctx com.types; let code = build_code ctx com.types com.main in @@ -4072,7 +4115,7 @@ let generate com = ) code.functions; close_out ch; end;*) - if Common.raw_defined com "hl-check" then begin + if hl_check then begin check ctx; Hlinterp.check code false; end; @@ -4098,6 +4141,8 @@ let generate com = let ch = open_out_bin com.file in output_string ch str; close_out ch; + prev_sign := sign; + prev_data := str; end; Hlopt.clean_cache(); t(); diff --git a/src/generators/genhxold.ml b/src/generators/genhxold.ml index 988badee..482e658b 100644 --- a/src/generators/genhxold.ml +++ b/src/generators/genhxold.ml @@ -107,7 +107,7 @@ let generate_type com t = | TDynamic t2 -> if t == t2 then "Dynamic" else "Dynamic<" ^ stype t2 ^ ">" | TFun ([],ret) -> - "Void -> " ^ ftype ret + "() -> " ^ ftype ret | TFun (args,ret) -> String.concat " -> " (List.map (fun (_,_,t) -> ftype t) args) ^ " -> " ^ ftype ret and ftype t = @@ -142,7 +142,7 @@ let generate_type com t = let print_meta ml = List.iter (fun (m,pl,_) -> match m with - | Meta.DefParam | Meta.CoreApi | Meta.Used | Meta.MaybeUsed | Meta.FlatEnum | Meta.Value | Meta.DirectlyUsed | Meta.Enum | Meta.Impl -> () + | Meta.DefParam | Meta.CoreApi | Meta.Used | Meta.MaybeUsed | Meta.FlatEnum | Meta.Value | Meta.DirectlyUsed | Meta.Enum -> () | _ -> match pl with | [] -> p "@%s " (Meta.to_string m) @@ -202,18 +202,18 @@ let generate_type com t = p "function %s%s(%s) : %s" name tparams (String.concat ", " (List.map sparam params)) (stype ret); ); p ";\n"; - if Meta.has Meta.Overload f.cf_meta then List.iter (fun f -> print_field stat f) f.cf_overloads + if has_class_field_flag f CfOverload then List.iter (fun f -> print_field stat f) f.cf_overloads in (match t with | TClassDecl c -> print_meta c.cl_meta; - let finalmod = if c.cl_final then "final " else "" in - p "extern %s%s %s" finalmod (if c.cl_interface then "interface" else "class") (stype (TInst (c,List.map snd c.cl_params))); + let finalmod = if (has_class_flag c CFinal) then "final " else "" in + p "extern %s%s %s" finalmod (if (has_class_flag c CInterface) then "interface" else "class") (stype (TInst (c,List.map snd c.cl_params))); let ext = (match c.cl_super with | None -> [] | Some (c,pl) -> [" extends " ^ stype (TInst (c,pl))] ) in - let ext = List.fold_left (fun acc (i,pl) -> ((if c.cl_interface then " extends " else " implements ") ^ stype (TInst (i,pl))) :: acc) ext c.cl_implements in + let ext = List.fold_left (fun acc (i,pl) -> ((if (has_class_flag c CInterface) then " extends " else " implements ") ^ stype (TInst (i,pl))) :: acc) ext c.cl_implements in let ext = (match c.cl_dynamic with | None -> ext | Some t -> @@ -234,7 +234,7 @@ let generate_type com t = p "%s" (String.concat "" (List.rev ext)); p " {\n"; let sort l = - let a = Array.of_list (List.filter (fun f -> not (List.memq f c.cl_overrides)) l) in + let a = Array.of_list (List.filter (fun f -> not (has_class_field_flag f CfOverride)) l) in let name = function "new" -> "" | n -> n in Array.sort (fun f1 f2 -> match f1.cf_kind, f2.cf_kind with @@ -268,7 +268,7 @@ let generate_type com t = print_meta a.a_meta; Option.may (fun c -> try print_meta [Meta.get Meta.Require c.cl_meta] with Not_found -> ()) a.a_impl; p "extern "; - let is_enum = Meta.has Meta.Enum a.a_meta in + let is_enum = a.a_enum in if is_enum then p "enum "; p "abstract %s" (stype (TAbstract (a,List.map snd a.a_params))); if not (Meta.has Meta.CoreType a.a_meta) then p "(%s)" (stype a.a_this); @@ -288,8 +288,8 @@ let generate_type com t = in List.iter (fun f -> - let static = not (Meta.has Meta.Impl f.cf_meta) in - if not static && is_enum && Meta.has Meta.Enum f.cf_meta then begin + let static = not (has_class_field_flag f CfImpl) in + if not static && is_enum && has_class_field_flag f CfEnum then begin p "\tvar %s;\n" f.cf_name; end else print_field static f diff --git a/src/generators/genjava.ml b/src/generators/genjava.ml index ab28b5e4..0b3b0d23 100644 --- a/src/generators/genjava.ml +++ b/src/generators/genjava.ml @@ -16,7 +16,7 @@ along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. *) - +open Extlib_leftovers open Globals open JData open Unix @@ -117,9 +117,7 @@ let is_dynamic gen t = | TDynamic _ -> true | _ -> false -let is_type_param t = match follow t with - | TInst({ cl_kind = KTypeParameter _ }, _) -> true - | _ -> false +let is_type_param t = ExtType.is_type_param (follow t) let rec t_has_type_param_shallow last t = match follow t with | TInst({ cl_kind = KTypeParameter _ }, []) -> true @@ -1668,6 +1666,7 @@ let generate con = acc + 1 ) 0 el); write w ")" + | TUnop (Ast.Spread, Prefix, e) -> expr_s w e | TUnop ((Ast.Increment as op), flag, e) | TUnop ((Ast.Decrement as op), flag, e) -> (match flag with @@ -1920,7 +1919,7 @@ let generate con = in let rec gen_class_field w ?(is_overload=false) is_static cl is_final cf = - let is_interface = cl.cl_interface in + let is_interface = (has_class_flag cl CInterface) in let name, is_new, is_explicit_iface = match cf.cf_name with | "new" -> snd cl.cl_path, true, false | name when String.contains name '.' -> @@ -1945,13 +1944,13 @@ let generate con = ) end (* TODO see how (get,set) variable handle when they are interfaces *) | Method _ when not (Type.is_physical_field cf) || (match cl.cl_kind, cf.cf_expr with | KAbstractImpl _, None -> true | _ -> false) -> - List.iter (fun cf -> if cl.cl_interface || cf.cf_expr <> None then + List.iter (fun cf -> if (has_class_flag cl CInterface) || cf.cf_expr <> None then gen_class_field w ~is_overload:true is_static cl (has_class_field_flag cf CfFinal) cf ) cf.cf_overloads | Var _ | Method MethDynamic -> () | Method mkind -> List.iter (fun cf -> - if cl.cl_interface || cf.cf_expr <> None then + if (has_class_flag cl CInterface) || (has_class_flag cl CAbstract) || cf.cf_expr <> None then gen_class_field w ~is_overload:true is_static cl (has_class_field_flag cf CfFinal) cf ) cf.cf_overloads; let is_virtual = is_new || (not is_final && match mkind with | MethInline -> false | _ when not is_new -> true | _ -> false) in @@ -1962,9 +1961,9 @@ let generate con = (match (real_type t, real_type ret) with | TDynamic _, TAbstract ({ a_path = ([], "Bool") },[]) | TAnon _, TAbstract ({ a_path = ([], "Bool") },[]) -> true - | _ -> List.memq cf cl.cl_overrides + | _ -> has_class_field_flag cf CfOverride ) - | _ -> List.memq cf cl.cl_overrides) + | _ -> has_class_field_flag cf CfOverride) | "toString" when not is_static -> (match cf.cf_type with | TFun([], ret) -> @@ -1972,7 +1971,7 @@ let generate con = | TInst( { cl_path = ([], "String") }, []) -> true | _ -> gen.gcon.error "A toString() function should return a String!" cf.cf_pos; false ) - | _ -> List.memq cf cl.cl_overrides + | _ -> has_class_field_flag cf CfOverride ) | "hashCode" when not is_static -> (match cf.cf_type with @@ -1982,21 +1981,33 @@ let generate con = true | _ -> gen.gcon.error "A hashCode() function should return an Int!" cf.cf_pos; false ) - | _ -> List.memq cf cl.cl_overrides + | _ -> has_class_field_flag cf CfOverride ) - | _ -> List.memq cf cl.cl_overrides + | _ -> has_class_field_flag cf CfOverride in let visibility = if is_interface then "" else "public" in let visibility, modifiers = get_fun_modifiers cf.cf_meta visibility [] in + let is_abstract = has_class_field_flag cf CfAbstract in + let modifiers = if is_abstract then "abstract" :: modifiers else modifiers in let visibility, is_virtual = if is_explicit_iface then "",false else visibility, is_virtual in let v_n = if is_static then "static" else if is_override && not is_interface then "" else if not is_virtual then "final" else "" in - let cf_type = if is_override && not is_overload && not (Meta.has Meta.Overload cf.cf_meta) then match field_access gen (TInst(cl, List.map snd cl.cl_params)) cf.cf_name with | FClassField(_,_,_,_,_,actual_t,_) -> actual_t | _ -> die "" __LOC__ else cf.cf_type in + let cf_type = if is_override && not is_overload && not (has_class_field_flag cf CfOverload) then match field_access gen (TInst(cl, List.map snd cl.cl_params)) cf.cf_name with | FClassField(_,_,_,_,_,actual_t,_) -> actual_t | _ -> die "" __LOC__ else cf.cf_type in let params = List.map snd cl.cl_params in - let ret_type, args = match follow cf_type, follow cf.cf_type with + let ret_type, args, has_rest_args = match follow cf_type, follow cf.cf_type with | TFun (strbtl, t), TFun(rargs, _) -> - (apply_params cl.cl_params params (real_type t), List.map2 (fun(_,_,t) (n,o,_) -> (n,o,apply_params cl.cl_params params (real_type t))) strbtl rargs) + let ret_type = apply_params cl.cl_params params (real_type t) + and args = + List.map2 (fun(_,_,t) (n,o,_) -> + (n,o,apply_params cl.cl_params params (real_type t)) + ) strbtl rargs + and rest = + match List.rev rargs with + | (_,_,t) :: _ -> ExtType.is_rest (follow t) + | _ -> false + in + ret_type,args,rest | _ -> die "" __LOC__ in @@ -2008,13 +2019,27 @@ let generate con = write_parts w (visibility :: v_n :: modifiers @ [params; (if is_new then "" else rett_s cf.cf_pos (run_follow gen ret_type)); (change_field name)]); (* (string arg1, object arg2) with T : object *) - (match cf.cf_expr with + let arg_names = + match cf.cf_expr with | Some { eexpr = TFunction tf } -> - print w "(%s)" (String.concat ", " (List.map2 (fun (var,_) (_,_,t) -> sprintf "%s %s" (argt_s cf.cf_pos (run_follow gen t)) (change_id var.v_name)) tf.tf_args args)) + List.map (fun (var,_) -> change_id var.v_name) tf.tf_args | _ -> - print w "(%s)" (String.concat ", " (List.map (fun (name, _, t) -> sprintf "%s %s" (argt_s cf.cf_pos (run_follow gen t)) (change_id name)) args)) - ); - if is_interface || List.mem "native" modifiers then + List.map (fun (name,_,_) -> change_id name) args + in + let rec loop acc names args = + match names, args with + | [], [] -> acc + | _, [] | [], _ -> + die "" __LOC__ + | [name], [_,_,TInst ({ cl_path = ["java"],"NativeArray" }, [t])] when has_rest_args -> + let arg = sprintf "%s ...%s" (argt_s cf.cf_pos (run_follow gen t)) name in + arg :: acc + | name :: names, (_,_,t) :: args -> + let arg = sprintf "%s %s" (argt_s cf.cf_pos (run_follow gen t)) name in + loop (arg :: acc) names args + in + print w "(%s)" (String.concat ", " (List.rev (loop [] arg_names args))); + if is_interface || List.mem "native" modifiers || is_abstract then write w ";" else begin let rec loop meta = @@ -2109,9 +2134,11 @@ let generate con = newline w; gen_annotations w cl.cl_meta; - let clt, access, modifiers = get_class_modifiers cl.cl_meta (if cl.cl_interface then "interface" else "class") "public" [] in - let modifiers = if cl.cl_final then "final" :: modifiers else modifiers in - let is_final = cl.cl_final in + let clt, access, modifiers = get_class_modifiers cl.cl_meta (if (has_class_flag cl CInterface) then "interface" else "class") "public" [] in + let is_final = has_class_flag cl CFinal in + let is_abstract = has_class_flag cl CAbstract in + let modifiers = if is_final then "final" :: modifiers else modifiers in + let modifiers = if is_abstract then "abstract" :: modifiers else modifiers in write_parts w (access :: modifiers @ [clt; (change_clname (snd cl.cl_path))]); @@ -2128,7 +2155,7 @@ let generate con = (if is_some cl.cl_super then print w " extends %s" (cl_p_to_string (get cl.cl_super))); (match cl.cl_implements with | [] -> () - | _ -> print w " %s %s" (if cl.cl_interface then "extends" else "implements") (String.concat ", " (List.map cl_p_to_string cl.cl_implements)) + | _ -> print w " %s %s" (if (has_class_flag cl CInterface) then "extends" else "implements") (String.concat ", " (List.map cl_p_to_string cl.cl_implements)) ); (* class head ok: *) (* public class Test : X, Y, Z where A : Y *) @@ -2183,7 +2210,7 @@ let generate con = ); (if is_some cl.cl_constructor then gen_class_field w false cl is_final (get cl.cl_constructor)); - (if not cl.cl_interface then List.iter (gen_class_field w true cl is_final) cl.cl_ordered_statics); + (if not (has_class_flag cl CInterface) then List.iter (gen_class_field w true cl is_final) cl.cl_ordered_statics); List.iter (gen_class_field w false cl is_final) cl.cl_ordered_fields; end_block w; @@ -2224,12 +2251,12 @@ let generate con = Codegen.map_source_header gen.gcon (fun s -> print w "// %s\n" s); match md_tp with | TClassDecl cl -> - if not cl.cl_extern then begin + if not (has_class_flag cl CExtern) then begin gen_class w cl; newline w; newline w end; - (not cl.cl_extern) + (not (has_class_flag cl CExtern)) | TEnumDecl e -> if not e.e_extern && not (Meta.has Meta.Class e.e_meta) then begin gen_enum w e; @@ -2438,7 +2465,7 @@ let generate con = TArrayTransform.configure gen ( fun e _ -> match e.eexpr with - | TArray ({ eexpr = TLocal { v_extra = Some( _ :: _, _) } }, _) -> (* captured transformation *) + | TArray ({ eexpr = TLocal { v_extra = Some({v_params = _ :: _}) } }, _) -> (* captured transformation *) false | TArray(e1, e2) -> ( match run_follow gen (follow e1.etype) with @@ -2633,7 +2660,7 @@ let generate con = output_string f v; close_out f; - out_files := (Path.UniqueKey.create full_path) :: !out_files + out_files := (gen.gcon.file_keys#get full_path) :: !out_files ) gen.gcon.resources; (try let c = get_cl (Hashtbl.find gen.gtypes (["haxe"], "Resource")) in @@ -2659,7 +2686,7 @@ let generate con = ) gen.gtypes_list; if not (Common.defined gen.gcon Define.KeepOldOutput) then - clean_files (gen.gcon.file ^ "/src") !out_files gen.gcon.verbose; + clean_files gen (gen.gcon.file ^ "/src") !out_files gen.gcon.verbose; let path_s_desc path = path_s path [] in dump_descriptor gen ("hxjava_build.txt") path_s_desc (fun md -> path_s_desc (t_infos md).mt_path); @@ -2667,6 +2694,14 @@ let generate con = let old_dir = Sys.getcwd() in Sys.chdir gen.gcon.file; let cmd = "haxelib run hxjava hxjava_build.txt --haxe-version " ^ (string_of_int gen.gcon.version) ^ " --feature-level 1" in + let cmd = + match gen.gentry_point with + | Some (name,_,_) -> + let name = if gen.gcon.debug then name ^ "-Debug" else name in + cmd ^ " --out " ^ gen.gcon.file ^ "/" ^ name + | _ -> + cmd + in print_endline cmd; if gen.gcon.run_command cmd <> 0 then failwith "Build failed"; Sys.chdir old_dir; diff --git a/src/generators/genjs.ml b/src/generators/genjs.ml index dc7b3dde..a7a10d0e 100644 --- a/src/generators/genjs.ml +++ b/src/generators/genjs.ml @@ -16,7 +16,7 @@ along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. *) - +open Extlib_leftovers open Globals open Ast open Type @@ -142,7 +142,7 @@ let anon_field s = if Hashtbl.mem kwds s || not (valid_js_ident s) then "'" ^ s let static_field ctx c f = let s = f.cf_name in match s with - | "length" | "name" when not c.cl_extern || Meta.has Meta.HxGen c.cl_meta -> + | "length" | "name" when not (has_class_flag c CExtern) || Meta.has Meta.HxGen c.cl_meta -> (match f.cf_kind with | Method _ when ctx.es_version >= 6 -> "." ^ s @@ -151,6 +151,18 @@ let static_field ctx c f = | s -> field s +let module_field m f = + try + fst (TypeloadCheck.get_native_name f.cf_meta) + with Not_found -> + Path.flat_path m.m_path ^ "_" ^ f.cf_name + +let module_field_expose_path mpath f = + try + fst (TypeloadCheck.get_native_name f.cf_meta) + with Not_found -> + (dot_path mpath) ^ "." ^ f.cf_name + let has_feature ctx = Common.has_feature ctx.com let add_feature ctx = Common.add_feature ctx.com @@ -314,6 +326,27 @@ let rec concat ctx s f = function spr ctx s; concat ctx s f l +(** + Produce expressions to declare arguments of a function with `Rest` trailing argument. + Used for ES5 and older standards, which don't support "rest parameters" syntax. + `args` is a list of explicitly defined arguments. + `rest_arg` is the argument of `Rest` type. + + This implementation copies rest arguments into a new array in a loop. + It's the only way to avoid disabling javascript VM optimizations of functions + with rest arguments. +*) +let declare_rest_args_legacy com offset rest_arg = + let i = string_of_int offset in + let new_array = mk (TIdent ("new Array($l>" ^ i ^ "?$l-"^ i ^":0)")) t_dynamic rest_arg.v_pos + and populate = mk (TIdent ("for(var $i=" ^ i ^ ";$i<$l;++$i){" ^ (ident rest_arg.v_name) ^ "[$i-" ^ i ^ "]=arguments[$i];}")) com.basic.tvoid rest_arg.v_pos + in + [ + mk (TIdent ("var $l=arguments.length")) com.basic.tvoid rest_arg.v_pos; + mk (TVar (rest_arg,Some new_array)) com.basic.tvoid rest_arg.v_pos; + populate + ] + let fun_block ctx f p = let e = List.fold_left (fun e (a,c) -> match c with @@ -384,12 +417,28 @@ let var ctx = if ctx.es_version >= 6 then "let" else "var" let rec gen_call ctx e el in_value = + let apply,el = + if ctx.es_version < 6 then + match List.rev el with + | [{ eexpr = TUnop (Spread,Ast.Prefix,rest) }] -> + true,[rest] + | { eexpr = TUnop (Spread,Ast.Prefix,rest) } :: args_rev -> + (* [arg1, arg2, ..., argN].concat(rest) *) + let arr = mk (TArrayDecl (List.rev args_rev)) t_dynamic null_pos in + let concat = mk (TField (arr, FDynamic "concat")) t_dynamic null_pos in + true,[mk (TCall (concat, [rest])) t_dynamic null_pos] + | _ -> + false,el + else + false,el + in match e.eexpr , el with | TConst TSuper , params when ctx.es_version < 6 -> (match ctx.current.cl_super with | None -> abort "Missing api.setCurrentClass" e.epos | Some (c,_) -> - print ctx "%s.call(%s" (ctx.type_accessor (TClassDecl c)) (this ctx); + let call = if apply then "apply" else "call" in + print ctx "%s.%s(%s" (ctx.type_accessor (TClassDecl c)) call (this ctx); List.iter (fun p -> print ctx ","; gen_value ctx p) params; spr ctx ")"; ); @@ -398,17 +447,22 @@ let rec gen_call ctx e el in_value = | None -> abort "Missing api.setCurrentClass" e.epos | Some (c,_) -> let name = field_name f in - print ctx "%s.prototype%s.call(%s" (ctx.type_accessor (TClassDecl c)) (field name) (this ctx); + let call = if apply then "apply" else "call" in + print ctx "%s.prototype%s.%s(%s" (ctx.type_accessor (TClassDecl c)) (field name) call (this ctx); List.iter (fun p -> print ctx ","; gen_value ctx p) params; spr ctx ")"; ); | TCall (x,_) , el when not (is_code_injection_function x) -> - spr ctx "("; - gen_value ctx e; - spr ctx ")"; - spr ctx "("; - concat ctx "," (gen_value ctx) el; - spr ctx ")"; + if apply then + gen_call_with_apply ctx e el + else begin + spr ctx "("; + gen_value ctx e; + spr ctx ")"; + spr ctx "("; + concat ctx "," (gen_value ctx) el; + spr ctx ")"; + end | TField (_, FStatic ({ cl_path = ["js"],"Syntax" }, { cf_name = meth })), args -> gen_syntax ctx meth args e.epos | TField (_, FStatic ({ cl_path = ["js"],"Lib" }, { cf_name = "rethrow" })), [] -> @@ -495,9 +549,32 @@ let rec gen_call ctx e el in_value = gen_value ctx x; print ctx ")"; | _ -> - gen_value ctx e; - spr ctx "("; - concat ctx "," (gen_value ctx) el; + if apply then + gen_call_with_apply ctx e el + else begin + gen_value ctx e; + spr ctx "("; + concat ctx "," (gen_value ctx) el; + spr ctx ")" + end + +and gen_call_with_apply ctx target args = + (match args with + | [_] -> () + | _ -> die ~p:target.epos "`args` for `gen_call_with_apply` must contain exactly one item" __LOC__ + ); + match target.eexpr with + | TField (this, (FInstance (_,_,{ cf_name = field }) | FAnon { cf_name = field } | FDynamic field | FClosure (_,{ cf_name = field }))) -> + add_feature ctx "thisForCallWithRestArgs"; + spr ctx "($_="; + gen_value ctx this; + spr ctx (",$_." ^ field ^ ".apply($_,"); + concat ctx "," (gen_value ctx) args; + spr ctx "))" + | _ -> + gen_value ctx target; + spr ctx ".apply(null,"; + concat ctx "," (gen_value ctx) args; spr ctx ")" (* @@ -601,6 +678,8 @@ and gen_expr ctx e = spr ctx f.cf_name; | TField (x, (FInstance(_,_,f) | FStatic(_,f) | FAnon(f))) when Meta.has Meta.SelfCall f.cf_meta -> gen_value ctx x; + | TField (_,FStatic ({ cl_kind = KModuleFields m },f)) -> + spr ctx (module_field m f) | TField (x,f) -> let rec skip e = match e.eexpr with | TCast(e1,None) | TMeta(_,e1) -> skip e1 @@ -808,35 +887,65 @@ and gen_function ?(keyword="function") ctx f pos = let old = ctx.in_value, ctx.in_loop in ctx.in_value <- None; ctx.in_loop <- false; - let args = List.map (fun (v,_) -> - check_var_declaration v; - ident v.v_name - ) f.tf_args in + let mk_non_rest_arg_names = + List.map (fun (v,_) -> + check_var_declaration v; + ident v.v_name + ) + in + let f,args = + match List.rev f.tf_args with + | (v,None) :: args_rev when ExtType.is_rest (follow v.v_type) -> + (* Use ES6 rest args syntax: `...arg` *) + if ctx.es_version >= 6 then + f, List.map (fun (a,_) -> + check_var_declaration a; + if a == v then ("..." ^ ident a.v_name) + else ident a.v_name + ) f.tf_args + (* Resort to `arguments` special object for ES < 6 *) + else begin + check_var_declaration v; + let non_rest_args = List.rev args_rev in + let args_decl = declare_rest_args_legacy ctx.com (List.length non_rest_args) v in + let body = + let el = + match f.tf_expr.eexpr with + | TBlock el -> args_decl @ el + | _ -> args_decl @ [f.tf_expr] + in + mk (TBlock el) f.tf_expr.etype f.tf_expr.epos + in + { f with tf_args = non_rest_args; tf_expr = body }, mk_non_rest_arg_names non_rest_args + end + | _ -> + f, mk_non_rest_arg_names f.tf_args + in print ctx "%s(%s) " keyword (String.concat "," args); gen_expr ctx (fun_block ctx f pos); ctx.in_value <- fst old; ctx.in_loop <- snd old; ctx.separator <- true -and gen_block_element ?(after=false) ctx e = +and gen_block_element ?(newline_after=false) ?(keep_blocks=false) ctx e = match e.eexpr with - | TBlock el -> - List.iter (gen_block_element ~after ctx) el + | TBlock el when not keep_blocks -> + List.iter (gen_block_element ~newline_after ctx) el | TCall ({ eexpr = TIdent "__feature__" }, { eexpr = TConst (TString f) } :: eif :: eelse) -> if has_feature ctx f then - gen_block_element ~after ctx eif + gen_block_element ~newline_after ctx eif else (match eelse with | [] -> () - | [e] -> gen_block_element ~after ctx e + | [e] -> gen_block_element ~newline_after ctx e | _ -> die "" __LOC__) | TFunction _ -> - gen_block_element ~after ctx (mk (TParenthesis e) e.etype e.epos) + gen_block_element ~newline_after ctx (mk (TParenthesis e) e.etype e.epos) | TObjectDecl fl -> - List.iter (fun (_,e) -> gen_block_element ~after ctx e) fl + List.iter (fun (_,e) -> gen_block_element ~newline_after ctx e) fl | _ -> - if not after then newline ctx; + if not newline_after then newline ctx; gen_expr ctx e; - if after then newline ctx + if newline_after then newline ctx and gen_value ctx e = let clear_mapping = add_mapping ctx e in @@ -1085,6 +1194,31 @@ let path_to_brackets path = let parts = ExtString.String.nsplit path "." in "[\"" ^ (String.concat "\"][\"" parts) ^ "\"]" +let gen_module_fields ctx m c fl = + List.iter (fun f -> + let name = module_field m f in + match f.cf_expr with + | None when not (is_physical_field f) -> + () + | None -> + print ctx "var %s = null" name; + newline ctx + | Some e -> + match e.eexpr with + | TFunction fn -> + ctx.id_counter <- 0; + print ctx "function %s" name; + gen_function ~keyword:"" ctx fn e.epos; + ctx.separator <- false; + newline ctx; + process_expose f.cf_meta (fun () -> module_field_expose_path m.m_path f) (fun s -> + print ctx "$hx_exports%s = %s" (path_to_brackets s) name; + newline ctx + ) + | _ -> + ctx.statics <- (c,f,e) :: ctx.statics + ) fl + let gen_class_static_field ctx c cl_path f = match f.cf_expr with | None | Some { eexpr = TConst TNull } when not (has_feature ctx "Type.getClassFields") -> @@ -1141,7 +1275,7 @@ let generate_class___name__ ctx cl_path = end let generate_class___isInterface__ ctx c = - if c.cl_interface && has_feature ctx "js.Boot.isInterface" then begin + if (has_class_flag c CInterface) && has_feature ctx "js.Boot.isInterface" then begin let p = s_path ctx c.cl_path in print ctx "%s.__isInterface__ = true" p; newline ctx; @@ -1396,7 +1530,7 @@ let generate_class_es6 ctx c = let props_to_generate = if has_property_reflection then Codegen.get_properties c.cl_ordered_fields else [] in let fields_to_generate = if has_feature ctx "Type.getInstanceFields" then - if c.cl_interface then + if (has_class_flag c CInterface) then List.filter is_physical_field c.cl_ordered_fields else List.filter is_physical_var_field nonmethod_fields @@ -1440,10 +1574,14 @@ let generate_class ctx c = (match c.cl_path with | [],"Function" -> abort "This class redefine a native one" c.cl_pos | _ -> ()); - if ctx.es_version >= 6 then - generate_class_es6 ctx c - else - generate_class_es3 ctx c + match c.cl_kind with + | KModuleFields m -> + gen_module_fields ctx m c c.cl_ordered_statics + | _ -> + if ctx.es_version >= 6 then + generate_class_es6 ctx c + else + generate_class_es3 ctx c let generate_enum ctx e = let p = s_path ctx e.e_path in @@ -1460,8 +1598,11 @@ let generate_enum ctx e = else if has_feature ctx "Type.resolveEnum" then print ctx "$hxClasses[\"%s\"] = " dotp); spr ctx "{"; - if has_feature ctx "js.Boot.isEnum" then print ctx " __ename__ : %s," (if has_feature ctx "Type.getEnumName" then "\"" ^ dotp ^ "\"" else "true"); - print ctx " __constructs__ : [%s]" (String.concat "," (List.map (fun s -> Printf.sprintf "\"%s\"" s) e.e_names)); + if has_feature ctx "js.Boot.isEnum" then print ctx " __ename__:%s," (if has_feature ctx "Type.getEnumName" then "\"" ^ dotp ^ "\"" else "true"); + if as_objects then + print ctx "__constructs__:null" + else + print ctx "__constructs__:[%s]" (String.concat "," (List.map (fun s -> Printf.sprintf "\"%s\"" s) e.e_names)); let bend = if not as_objects then begin spr ctx " }"; @@ -1488,7 +1629,7 @@ let generate_enum ctx e = print ctx "($_=function(%s) { return {_hx_index:%d,%s,__enum__:\"%s\"" sargs f.ef_index sfields dotp; if has_enum_feature then spr ctx ",toString:$estr"; - print ctx "}; },$_.__params__ = [%s],$_)" sparams + print ctx "}; },$_._hx_name=\"%s\",$_.__params__ = [%s],$_)" f.ef_name sparams end else begin print ctx "function(%s) { var $x = [\"%s\",%d,%s]; $x.__enum__ = %s;" sargs f.ef_name f.ef_index sargs p; if has_enum_feature then @@ -1497,7 +1638,7 @@ let generate_enum ctx e = end end; | _ -> if as_objects then - print ctx "{_hx_index:%d,__enum__:\"%s\"%s}" f.ef_index dotp (if has_enum_feature then ",toString:$estr" else "") + print ctx "{_hx_name:\"%s\",_hx_index:%d,__enum__:\"%s\"%s}" f.ef_name f.ef_index dotp (if has_enum_feature then ",toString:$estr" else "") else begin print ctx "[\"%s\",%d]" f.ef_name f.ef_index; newline ctx; @@ -1516,6 +1657,8 @@ let generate_enum ctx e = spr ctx "\n}"; ctx.separator <- true; newline ctx; + print ctx "%s.__constructs__ = [%s]" p (String.concat "," (List.map (fun s -> Printf.sprintf "%s%s" p (field s)) e.e_names)); + newline ctx; end; if has_feature ctx "Type.allEnums" then begin let ctors_without_args = List.filter (fun s -> @@ -1537,9 +1680,16 @@ let generate_enum ctx e = flush ctx let generate_static ctx (c,f,e) = - let cl_path = get_generated_class_path c in - process_expose f.cf_meta (fun () -> (dot_path cl_path) ^ "." ^ f.cf_name) (fun s -> print ctx "$hx_exports%s = " (path_to_brackets s)); - print ctx "%s%s = " (s_path ctx cl_path) (static_field ctx c f); + begin + match c.cl_kind with + | KModuleFields m -> + print ctx "var %s = " (module_field m f); + process_expose f.cf_meta (fun () -> module_field_expose_path m.m_path f) (fun s -> print ctx "$hx_exports%s = " (path_to_brackets s)); + | _ -> + let cl_path = get_generated_class_path c in + process_expose f.cf_meta (fun () -> (dot_path cl_path) ^ "." ^ f.cf_name) (fun s -> print ctx "$hx_exports%s = " (path_to_brackets s)); + print ctx "%s%s = " (s_path ctx cl_path) (static_field ctx c f); + end; gen_value ctx e; newline ctx @@ -1579,8 +1729,8 @@ let generate_type ctx = function (* Another special case for Std because we do not want to generate it if it's empty. *) if p = "Std" && c.cl_ordered_statics = [] then () - else if not c.cl_extern then begin - if (not c.cl_interface) || (need_to_generate_interface ctx c) then + else if not (has_class_flag c CExtern) then begin + if (not (has_class_flag c CInterface)) || (need_to_generate_interface ctx c) then generate_class ctx c end else if Meta.has Meta.JsRequire c.cl_meta && is_directly_used ctx.com c.cl_meta then generate_require ctx (get_generated_class_path c) c.cl_meta @@ -1643,7 +1793,7 @@ let alloc_ctx com es_version = dot_path e.e_path | TClassDecl c -> let p = get_generated_class_path c in - if c.cl_extern && not (Meta.has Meta.JsRequire c.cl_meta) then + if (has_class_flag c CExtern) && not (Meta.has Meta.JsRequire c.cl_meta) then dot_path p else s_path ctx p @@ -1683,11 +1833,18 @@ let generate com = List.iter ( function | TClassDecl c -> - let path = dot_path c.cl_path in let add s = r := s :: !r in - process_expose c.cl_meta (fun () -> path) add; + let get_expose_path = + match c.cl_kind with + | KModuleFields m -> + module_field_expose_path m.m_path + | _ -> + let path = dot_path c.cl_path in + process_expose c.cl_meta (fun () -> path) add; + fun f -> path ^ "." ^ f.cf_name + in List.iter (fun f -> - process_expose f.cf_meta (fun () -> path ^ "." ^ f.cf_name) add + process_expose f.cf_meta (fun () -> get_expose_path f) add ) c.cl_ordered_statics | _ -> () ) com.types; @@ -1814,9 +1971,9 @@ let generate com = let vars = if (enums_as_objects && (has_feature ctx "has_enum" || has_feature ctx "Type.resolveEnum")) then "$hxEnums = $hxEnums || {}" :: vars else vars in let vars,has_dollar_underscore = if List.exists (function TEnumDecl { e_extern = false } -> true | _ -> false) com.types then - "$_" :: vars,true + "$_" :: vars,ref true else - vars,false + vars,ref false in (match List.rev vars with | [] -> () @@ -1825,7 +1982,7 @@ let generate com = ctx.separator <- true; newline ctx ); - if ctx.es_version < 6 && List.exists (function TClassDecl { cl_extern = false; cl_super = Some _ } -> true | _ -> false) com.types then begin + if ctx.es_version < 6 && List.exists (function TClassDecl ({ cl_super = Some _ } as c) -> not (has_class_flag c CExtern) | _ -> false) com.types then begin let extend_code = "function $extend(from, fields) {\n" ^ ( @@ -1876,9 +2033,10 @@ let generate com = end; if has_feature ctx "use.$bind" then begin add_feature ctx "$global.$haxeUID"; - if not has_dollar_underscore then begin + if not !has_dollar_underscore then begin print ctx "var $_"; newline ctx; + has_dollar_underscore := true end; (if ctx.es_version < 5 then print ctx "function $bind(o,m) { if( m == null ) return null; if( m.__id__ == null ) m.__id__ = $global.$haxeUID++; var f; if( o.hx__closures__ == null ) o.hx__closures__ = {}; else f = o.hx__closures__[m.__id__]; if( f == null ) { f = function(){ return f.method.apply(f.scope, arguments); }; f.scope = o; f.method = m; o.hx__closures__[m.__id__] = f; } return f; }" @@ -1895,7 +2053,12 @@ let generate com = add_feature ctx "js.Lib.global"; print ctx "$global.$haxeUID |= 0;\n"; end; - List.iter (gen_block_element ~after:true ctx) (List.rev ctx.inits); + if not !has_dollar_underscore && has_feature ctx "thisForCallWithRestArgs" then begin + print ctx "var $_"; + newline ctx; + has_dollar_underscore := true + end; + List.iter (gen_block_element ~newline_after:true ~keep_blocks:(ctx.es_version >= 6) ctx) (List.rev ctx.inits); List.iter (generate_static ctx) (List.rev ctx.statics); (match com.main with | None -> () diff --git a/src/generators/genjvm.ml b/src/generators/genjvm.ml index a28dffc4..f04abc70 100644 --- a/src/generators/genjvm.ml +++ b/src/generators/genjvm.ml @@ -46,8 +46,6 @@ let get_construction_mode c cf = (* Haxe *) -exception HarderFailure of string - type generation_context = { com : Common.context; jar : Zip.out_file; @@ -60,8 +58,13 @@ type generation_context = { default_export_config : export_config; typed_functions : JvmFunctions.typed_functions; closure_paths : (path * string * jsignature,path) Hashtbl.t; + enum_paths : (path,unit) Hashtbl.t; + detail_times : bool; + mutable timer : Timer.timer; mutable typedef_interfaces : jsignature typedef_interfaces; mutable current_field_info : field_generation_info option; + jar_compression_level : int; + dynamic_level : int; } type ret = @@ -86,6 +89,16 @@ let need_val = function | RValue _ -> true | _ -> false +let run_timed gctx detail name f = + if detail && not gctx.detail_times then + f() + else begin + let sub = gctx.timer#nest name in + let old = gctx.timer in + gctx.timer <- sub; + sub#run_finally f (fun () -> gctx.timer <- old) + end + open NativeSignatures let rec jsignature_of_type gctx stack t = @@ -111,15 +124,19 @@ let rec jsignature_of_type gctx stack t = | [t] -> get_boxed_type (jsignature_of_type t) | _ -> die "" __LOC__ end - | (["haxe";"ds"],"Vector") | (["haxe";"extern"],"Rest") -> + | ["haxe";"ds"],"Vector" -> begin match tl with | [t] -> TArray(jsignature_of_type t,None) | _ -> die "" __LOC__ end + | ["haxe"],"Rest" -> TArray(object_sig,None) | [],"Dynamic" -> object_sig | [],("Class" | "Enum") -> - java_class_sig + begin match tl with + | [t] -> TObject(java_class_path,[TType(WNone,jsignature_of_type t)]) + | _ -> java_class_sig + end | [],"EnumValue" -> java_enum_sig object_sig | _ -> @@ -145,7 +162,9 @@ let rec jsignature_of_type gctx stack t = | TInst({cl_path = ["_Class"],"Class_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) - | TEnum(en,tl) -> TObject(en.e_path,List.map jtype_argument_of_type tl) + | TEnum(en,tl) -> + Hashtbl.replace gctx.enum_paths en.e_path (); + TObject(en.e_path,List.map jtype_argument_of_type tl) | TFun(tl,tr) -> method_sig (List.map (fun (_,o,t) -> let jsig = jsignature_of_type t in let jsig = if o then get_boxed_type jsig else jsig in @@ -173,10 +192,16 @@ let jsignature_of_type gctx t = let return_of_type gctx t = return_of_type gctx [] t -let convert_fields gctx fields = - let l = PMap.foldi (fun s cf acc -> (s,cf) :: acc) fields [] in - let l = List.sort (fun (s1,_) (s2,_) -> compare s1 s2) l in - List.map (fun (s,cf) -> s,jsignature_of_type gctx cf.cf_type) l +let convert_fields gctx pfm = + match pfm.pfm_converted with + | Some l -> + l + | None -> + let l = PMap.foldi (fun s cf acc -> (s,cf) :: acc) pfm.pfm_fields [] in + let l = List.sort (fun (s1,_) (s2,_) -> compare s1 s2) l in + let l = List.map (fun (s,cf) -> s,jsignature_of_type gctx cf.cf_type) l in + pfm.pfm_converted <- Some l; + l module AnnotationHandler = struct let generate_annotations builder meta = @@ -261,7 +286,7 @@ let resolve_class com path = in loop com.types -let write_class jar path jc = +let write_class gctx path jc = let dir = match path with | ([],s) -> s | (sl,s) -> String.concat "/" sl ^ "/" ^ s @@ -270,7 +295,7 @@ let write_class jar path jc = let t = Timer.timer ["jvm";"write"] in let ch = IO.output_bytes() in JvmWriter.write_jvm_class ch jc; - Zip.add_entry (Bytes.unsafe_to_string (IO.close_out ch)) jar path; + Zip.add_entry ~level:gctx.jar_compression_level (Bytes.unsafe_to_string (IO.close_out ch)) gctx.jar path; t() let is_const_int_pattern (el,_) = @@ -286,13 +311,10 @@ let is_const_string_pattern (el,_) = ) el let is_interface_var_access c cf = - c.cl_interface && match cf.cf_kind with + (has_class_flag c CInterface) && match cf.cf_kind with | Var _ | Method MethDynamic -> true | _ -> false -let type_unifies a b = - try Type.unify a b; true with _ -> false - let follow = Abstract.follow_with_abstracts class haxe_exception gctx (t : Type.t) = @@ -304,7 +326,7 @@ object(self) method is_assignable_to (exc2 : haxe_exception) = match self#is_haxe_exception,exc2#is_haxe_exception with | true, true | false, false -> - type_unifies t exc2#get_type + does_unify t exc2#get_type (* `haxe.Exception` is assignable to java.lang.RuntimeException/Exception/Throwable *) | false,true -> List.mem exc2#get_native_type [throwable_sig; exception_sig; runtime_exception_sig] @@ -378,7 +400,7 @@ let create_field_closure gctx jc path_this jm name jsig = code#bconst true; jm_equals#return; end; - write_class gctx.jar 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); jc_closure#get_this_path let create_field_closure gctx jc path_this jm name jsig f = @@ -474,7 +496,7 @@ class texpr_to_jvm gctx (jc : JvmClass.builder) (jm : JvmMethod.builder) (return method make_static_closure_field (name : string) (jc_closure : JvmClass.builder) = let jm_init = jc_closure#get_static_init_method in - let jf_closure = jc_closure#spawn_field name jc_closure#get_jsig [FdStatic;FdPublic] in + let jf_closure = jc_closure#spawn_field name jc_closure#get_jsig [FdStatic;FdPublic;FdFinal] in 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; @@ -532,7 +554,7 @@ class texpr_to_jvm gctx (jc : JvmClass.builder) (jm : JvmMethod.builder) (return ) env); ); end; - write_class gctx.jar 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); (* access *) @@ -586,7 +608,7 @@ class texpr_to_jvm gctx (jc : JvmClass.builder) (jm : JvmMethod.builder) (return Hashtbl.add gctx.closure_paths (path,name,jsig) jc_closure#get_this_path; (* Static init *) self#make_static_closure_field name jc_closure; - write_class gctx.jar 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); jc_closure#get_this_path; in jm#getstatic closure_path name (object_path_sig closure_path); @@ -599,6 +621,12 @@ class texpr_to_jvm gctx (jc : JvmClass.builder) (jm : JvmMethod.builder) (return in self#read_static_closure path cf.cf_name args ret in + let dynamic_read s = + self#texpr rvalue_any e1; + jm#string s; + jm#invokestatic haxe_jvm_path "readField" (method_sig [object_sig;string_sig] (Some object_sig)); + cast(); + in match fa with | FStatic({cl_path = (["java";"lang"],"Math")},({cf_name = "NaN" | "POSITIVE_INFINITY" | "NEGATIVE_INFINITY"} as cf)) -> jm#getstatic double_path cf.cf_name TDouble @@ -630,15 +658,15 @@ class texpr_to_jvm gctx (jc : JvmClass.builder) (jm : JvmMethod.builder) (return | FAnon cf -> self#texpr rvalue_any e1; self#read_anon_field cast e1.etype cf; - | FDynamic s | FInstance(_,_,{cf_name = s}) | FEnum(_,{ef_name = s}) | FClosure(Some({cl_interface = true},_),{cf_name = s}) | FClosure(None,{cf_name = s}) -> - self#texpr rvalue_any e1; - jm#string s; - jm#invokestatic haxe_jvm_path "readField" (method_sig [object_sig;string_sig] (Some object_sig)); - cast(); + | FDynamic s | FInstance(_,_,{cf_name = s}) | FEnum(_,{ef_name = s}) | FClosure(None,{cf_name = s}) -> + dynamic_read s | FClosure((Some(c,_)),cf) -> - create_field_closure gctx jc c.cl_path jm cf.cf_name (self#vtype cf.cf_type) (fun () -> - self#texpr rvalue_any e1; - ) + if has_class_flag c CInterface then + dynamic_read cf.cf_name + else + create_field_closure gctx jc c.cl_path jm cf.cf_name (self#vtype cf.cf_type) (fun () -> + self#texpr rvalue_any e1; + ) method read_write ret ak e (f : unit -> unit) = let apply dup = @@ -773,6 +801,12 @@ class texpr_to_jvm gctx (jc : JvmClass.builder) (jm : JvmMethod.builder) (return label_then2#here; self#condition flip e2 label_then label_else; in + let bool_or flip e1 e2 = + let label_else2 = jm#spawn_label "else2" in + self#condition (not flip) e1 label_else2 label_then; + label_else2#here; + self#condition flip e2 label_then label_else; + in let involves_float_compare e = let rec loop e = match e.eexpr with | TBinop((OpEq | OpNotEq | OpLt | OpGt | OpLte | OpGte),e1,e2) -> @@ -795,8 +829,12 @@ class texpr_to_jvm gctx (jc : JvmClass.builder) (jm : JvmMethod.builder) (return label_else#apply (self#apply_cmp (self#binop_compare op e1 e2)) | TBinop(OpBoolAnd,e1,e2) when not flip -> bool_and false e1 e2 + | TBinop(OpBoolAnd,e1,e2) when not (involves_float_compare e1) -> + bool_or true e1 e2 | TBinop(OpBoolOr,e1,e2) when flip -> bool_and true e1 e2 + | TBinop(OpBoolOr,e1,e2) when not (involves_float_compare e1) -> + bool_or false e1 e2 | TUnop(Not,_,e1) when not (involves_float_compare e1) -> self#condition (not flip) e1 label_then label_else | _ -> @@ -879,10 +917,10 @@ class texpr_to_jvm gctx (jc : JvmClass.builder) (jm : JvmMethod.builder) (return (* binops *) method binop_exprs cast_type f1 f2 = - f1(); - jm#cast ~allow_to_string:true cast_type; - f2(); - jm#cast ~allow_to_string:true cast_type; + f1 (rvalue_sig cast_type); + jm#cast cast_type; + f2 (rvalue_sig cast_type); + jm#cast cast_type; method get_binop_type_sig jsig1 jsig2 = match get_unboxed_type jsig1, get_unboxed_type jsig2 with @@ -974,7 +1012,7 @@ class texpr_to_jvm gctx (jc : JvmClass.builder) (jm : JvmMethod.builder) (return | _ -> match is_unboxed sig1,is_unboxed sig2 with | true,true -> - let f e () = self#texpr rvalue_any e in + let f e ret = self#texpr ret e in self#binop_exprs (self#get_binop_type e1.etype e2.etype) (f e1) (f e2); self#do_compare op | false,false -> @@ -1099,9 +1137,9 @@ class texpr_to_jvm gctx (jc : JvmClass.builder) (jm : JvmMethod.builder) (return emit_exprs(); code#imul | OpDiv -> - f1(); + f1 (rvalue_sig TDouble); jm#cast TDouble; - f2(); + f2 (rvalue_sig TDouble); jm#cast TDouble; code#ddiv; | OpAnd -> @@ -1171,21 +1209,21 @@ class texpr_to_jvm gctx (jc : JvmClass.builder) (jm : JvmMethod.builder) (return emit_exprs(); code#lxor_ | OpShl -> - f1(); + f1 (rvalue_sig TLong); jm#cast TLong; - f2(); + f2 (rvalue_sig TLong); jm#cast TInt; code#lshl; | OpShr -> - f1(); + f1 (rvalue_sig TLong); jm#cast TLong; - f2(); + f2 (rvalue_sig TInt); jm#cast TInt; code#lshr; | OpUShr -> - f1(); + f1 (rvalue_sig TLong); jm#cast TLong; - f2(); + f2 (rvalue_sig TInt); jm#cast TInt; code#lushr; | OpMod -> @@ -1197,7 +1235,7 @@ class texpr_to_jvm gctx (jc : JvmClass.builder) (jm : JvmMethod.builder) (return begin match op with | OpBoolAnd -> let operand f = - f(); + f (rvalue_sig TBool); jm#cast TBool; in operand f1; @@ -1207,7 +1245,7 @@ class texpr_to_jvm gctx (jc : JvmClass.builder) (jm : JvmMethod.builder) (return (fun () -> code#bconst false) | OpBoolOr -> let operand f = - f(); + f (rvalue_sig TBool); jm#cast TBool; in operand f1; @@ -1221,10 +1259,14 @@ class texpr_to_jvm gctx (jc : JvmClass.builder) (jm : JvmMethod.builder) (return jm#invokestatic haxe_jvm_path name (method_sig [object_sig;object_sig] (Some object_sig)) end | TObject(path,_) -> - emit_exprs(); - if path = string_path then + if path = string_path then begin + f1 rvalue_any; + jm#cast ~allow_to_string:true cast_type; + f2 rvalue_any; + jm#cast ~allow_to_string:true cast_type; jm#invokestatic haxe_jvm_path "stringConcat" (method_sig [object_sig;object_sig] (Some string_sig)) - else begin + end else begin + emit_exprs(); let name = method_name () in jm#invokestatic haxe_jvm_path name (method_sig [object_sig;object_sig] (Some object_sig)) end @@ -1267,13 +1309,13 @@ class texpr_to_jvm gctx (jc : JvmClass.builder) (jm : JvmMethod.builder) (return if need_val ret then load(); | _ -> let f () = - self#binop_basic ret op (self#get_binop_type e1.etype e2.etype) (fun () -> ()) (fun () -> self#texpr rvalue_any e2); + self#binop_basic ret op (self#get_binop_type e1.etype e2.etype) (fun _ -> ()) (fun ret -> self#texpr ret e2); jm#cast jsig1; in self#read_write ret AKPre e1 f end | _ -> - let f e () = self#texpr rvalue_any e in + let f e ret = self#texpr ret e in self#binop_basic ret op (self#get_binop_type e1.etype e2.etype) (f e1) (f e2) method unop ret op flag e = @@ -1318,6 +1360,8 @@ class texpr_to_jvm gctx (jc : JvmClass.builder) (jm : JvmMethod.builder) (return (self#condition false e) (fun () -> code#bconst false) (fun () -> code#bconst true) + | Spread, _ -> + self#texpr (rvalue_type gctx e.etype) e | NegBits,_ -> let jsig = jsignature_of_type gctx (follow e.etype) in self#texpr rvalue_any e; @@ -1336,33 +1380,42 @@ class texpr_to_jvm gctx (jc : JvmClass.builder) (jm : JvmMethod.builder) (return (* calls *) - method get_argument_signatures t el = - match jsignature_of_type gctx t with - | TMethod(jsigs,r) -> jsigs,r - | _ -> List.map (fun _ -> object_sig) el,(Some object_sig) - - method call_arguments t el = - let tl,tr = self#get_argument_signatures t el in - let varargs_type = match follow t with - | TFun(tl,_) -> - begin match List.rev tl with - | (_,_,(TAbstract({a_path = ["haxe";"extern"],"Rest"},[t]))) :: _ -> Some (jsignature_of_type gctx t) - | _ -> None - end + method call_arguments ?(cast=true) t el = + let tl,tr = match follow t with + | TFun(tl,tr) -> + tl,return_of_type gctx tr | _ -> - None + List.map (fun e -> ("",false,e.etype)) el,Some (object_sig) in let rec loop acc tl el = match tl,el with - | jsig :: tl,e :: el -> - begin match tl,varargs_type with - | [],Some jsig' -> - self#new_native_array jsig' (e :: el); + | (_,_,t) :: tl,e :: el -> + let jsig = jsignature_of_type gctx t in + begin match tl,Type.follow t with + | [],(TAbstract({a_path = ["haxe"],"Rest"},[t1])) -> + (match e.eexpr with + | TUnop (Spread,_,e) -> + self#texpr (rvalue_sig jsig) e + | _ -> + self#new_native_array (get_boxed_type (jsignature_of_type gctx t1)) (e :: el) + ); List.rev (jsig :: acc) | _ -> self#texpr (rvalue_sig jsig) e; - jm#cast jsig; - loop (jsig :: acc) tl el + let acc = if cast then begin + jm#cast jsig; + jsig :: acc + end else + code#get_stack#top :: acc + in + loop acc tl el end + | [(_,_,t)],[] -> + (match Type.follow t with + | TAbstract({a_path = ["haxe"],"Rest"},[t1]) -> + let jsig = jsignature_of_type gctx t in + self#new_native_array (get_boxed_type (jsignature_of_type gctx t1)) []; + List.rev (jsig :: acc) + | _ -> List.rev acc) | _,[] -> List.rev acc | [],e :: el -> (* TODO: this sucks *) @@ -1375,7 +1428,8 @@ class texpr_to_jvm gctx (jc : JvmClass.builder) (jm : JvmMethod.builder) (return method call ret tr e1 el = let invoke t = jm#cast haxe_function_sig; - let tl,tr = self#call_arguments t el in + (* We don't want to cast because typed functions handle that for us. *) + let tl,tr = self#call_arguments ~cast:false t el in let meth = gctx.typed_functions#register_signature tl tr in jm#invokevirtual haxe_function_path meth.name (method_sig meth.dargs meth.dret); tr @@ -1461,14 +1515,6 @@ class texpr_to_jvm gctx (jc : JvmClass.builder) (jm : JvmMethod.builder) (return Error.error (Printf.sprintf "Bad __array__ type: %s" (s_type (print_context()) tr)) e1.epos; end | TField(e1,FStatic(c,({cf_kind = Method (MethNormal | MethInline)} as cf))) -> - let c,cf = match cf.cf_overloads with - | [] -> c,cf - | _ -> match filter_overloads (find_overload (fun t -> t) c cf el) with - | None -> - Error.error "Could not find overload" e1.epos - | Some(c,cf,_) -> - c,cf - in let tl,tr = self#call_arguments cf.cf_type el in jm#invokestatic c.cl_path cf.cf_name (method_sig tl tr); tr @@ -1502,13 +1548,9 @@ class texpr_to_jvm gctx (jc : JvmClass.builder) (jm : JvmMethod.builder) (return self#texpr rvalue_any e1; false in - begin match find_overload_rec false (apply_params c.cl_params tl) c cf el with - | None -> Error.error "Could not find overload" e1.epos - | Some(c,cf,_) -> - let tl,tr = self#call_arguments cf.cf_type el in - (if is_super then jm#invokespecial else if c.cl_interface then jm#invokeinterface else jm#invokevirtual) c.cl_path cf.cf_name (self#vtype cf.cf_type); - tr - end + let tl,tr = self#call_arguments cf.cf_type el in + (if is_super then jm#invokespecial else if (has_class_flag c CInterface) then jm#invokeinterface else jm#invokevirtual) c.cl_path cf.cf_name (method_sig tl tr); + tr | TField(_,FEnum(en,ef)) -> let tl,_ = self#call_arguments ef.ef_type el in let tr = self#vtype tr in @@ -1687,7 +1729,8 @@ class texpr_to_jvm gctx (jc : JvmClass.builder) (jm : JvmMethod.builder) (return method const ret t ct = match ct with | Type.TInt i32 -> begin match ret with - | RValue (Some (TDouble | TObject((["java";"lang"],"Double"),_))) -> code#lconst (Int64.of_int32 i32) + | RValue (Some (TLong | TObject((["java";"lang"],"Long"),_))) -> code#lconst (Int64.of_int32 i32) + | RValue (Some (TDouble | TObject((["java";"lang"],"Double"),_))) -> code#dconst (Int32.to_float i32) | _ -> code#iconst i32 end | TFloat f -> @@ -1697,7 +1740,7 @@ class texpr_to_jvm gctx (jc : JvmClass.builder) (jm : JvmMethod.builder) (return end | TBool true -> code#bconst true | TBool false -> code#bconst false - | TNull -> code#aconst_null (self#vtype t) + | TNull -> jm#load_default_value (self#vtype t) | TThis -> let _,load,_ = self#get_local_by_id (0,"this") in load() @@ -1707,11 +1750,18 @@ class texpr_to_jvm gctx (jc : JvmClass.builder) (jm : JvmMethod.builder) (return method new_native_array jsig el = jm#new_native_array jsig (List.map (fun e -> fun () -> self#texpr (rvalue_sig jsig) e) el) + method spawn_compiled_pattern_field (s1 : string) (s2 : string) = + let name = Printf.sprintf "_hx_pattern_%s_%i" (patch_name jm#get_name) jm#get_next_regex_id in + let jf = jc#spawn_field name NativeSignatures.haxe_compiled_pattern_sig [FdStatic;FdPrivate;FdFinal] in + let jm = jc#get_static_init_method in + jm#string s1; + jm#string s2; + jm#invokestatic NativeSignatures.haxe_ereg_path "compilePattern" (method_sig [string_sig;string_sig] (Some NativeSignatures.haxe_compiled_pattern_sig)); + jm#putstatic jc#get_this_path jf#get_name jf#get_jsig; + jf + method texpr ret e = - try - if not jm#is_terminated then self#texpr' ret e - with Failure s -> - raise (HarderFailure (Printf.sprintf "Expr %s\n%s" (s_expr_pretty false "" false (s_type (print_context())) e) s)) + if not jm#is_terminated then self#texpr' ret e method texpr' ret e = code#set_line (Lexer.get_error_line e.epos); @@ -1845,18 +1895,21 @@ class texpr_to_jvm gctx (jc : JvmClass.builder) (jm : JvmMethod.builder) (return self#texpr (if need_val ret then rvalue_any else RVoid) e1; (* Technically this could throw... but whatever *) if need_val ret then ignore(NativeArray.create jm#get_code jc#get_pool (jsignature_of_type gctx t)) + | TNew({cl_path=(["haxe";"root"],"EReg") as ereg_path},[],[{eexpr = TConst (TString s1)};{eexpr = TConst (TString s2)}]) when jm != jc#get_static_init_method -> + let jf = self#spawn_compiled_pattern_field s1 s2 in + jm#construct ConstructInit ereg_path (fun () -> + jm#getstatic jc#get_this_path jf#get_name jf#get_jsig; + [jf#get_jsig] + ) | TNew(c,tl,el) -> - begin match get_constructor (fun cf -> cf.cf_type) c with - |_,cf -> - begin match find_overload_rec true (apply_params c.cl_params tl) c cf el with - | None -> Error.error "Could not find overload" e.epos - | Some (c',cf,_) -> - let f () = - let tl,_ = self#call_arguments cf.cf_type el in - tl - in - jm#construct ~no_value:(if not (need_val ret) then true else false) (get_construction_mode c' cf) c.cl_path f - end + begin match OverloadResolution.maybe_resolve_constructor_overload c tl el with + | None -> Error.error "Could not find overload" e.epos + | Some (c',cf,_) -> + let f () = + let tl,_ = self#call_arguments cf.cf_type el in + tl + in + jm#construct ~no_value:(if not (need_val ret) then true else false) (get_construction_mode c' cf) c.cl_path f end | TReturn None -> self#emit_block_exits false; @@ -1951,7 +2004,7 @@ class texpr_to_jvm gctx (jc : JvmClass.builder) (jm : JvmMethod.builder) (return self#cast e.etype; | TThrow e1 -> self#texpr rvalue_any e1; - if not (Exceptions.is_haxe_exception e1.etype) && not (type_unifies e1.etype gctx.t_runtime_exception) then begin + if not (Exceptions.is_haxe_exception e1.etype) && not (does_unify e1.etype gctx.t_runtime_exception) then begin let exc = new haxe_exception gctx e1.etype in if not (List.exists (fun exc' -> exc#is_assignable_to exc') caught_exceptions) then jm#add_thrown_exception exc#get_native_path; @@ -1964,7 +2017,7 @@ class texpr_to_jvm gctx (jc : JvmClass.builder) (jm : JvmMethod.builder) (return (* The guard is here because in the case of quoted fields like `"a-b"`, the field is not part of the type. In this case we have to do full dynamic construction. *) | TAnon an,Some pfm when List.for_all (fun ((name,_,_),_) -> PMap.mem name an.a_fields) fl -> - let fl' = convert_fields gctx pfm.pfm_fields in + let fl' = convert_fields gctx pfm in jm#construct ConstructInit pfm.pfm_path (fun () -> (* We have to respect declaration order, so let's temp var where necessary *) let rec loop fl fl' ok acc = match fl,fl' with @@ -2030,12 +2083,6 @@ type super_ctor_mode = | SCJava | SCHaxe -let failsafe p f = - try - f () - with Failure s | HarderFailure s -> - Error.error s p - let generate_dynamic_access gctx (jc : JvmClass.builder) fields is_anon = begin match fields with | [] -> @@ -2048,18 +2095,21 @@ let generate_dynamic_access gctx (jc : JvmClass.builder) fields is_anon = let cases = List.map (fun (name,jsig,kind) -> [name],(fun () -> begin match kind,jsig with - | Method (MethNormal | MethInline),TMethod(args,_) -> + | Method (MethNormal | MethInline),TMethod(args,_) -> + if gctx.dynamic_level >= 2 then begin + create_field_closure gctx jc jc#get_this_path jm name jsig (fun () -> jm#load_this) + end else begin jm#load_this; jm#string name; jm#new_native_array java_class_sig (List.map (fun jsig -> fun () -> jm#get_class jsig) args); jm#invokestatic haxe_jvm_path "readFieldClosure" (method_sig [object_sig;string_sig;array_sig (java_class_sig)] (Some (object_sig))) - | _ -> - jm#load_this; - jm#getfield jc#get_this_path name jsig; - jm#expect_reference_type; + end + | _ -> + jm#load_this; + jm#getfield jc#get_this_path name jsig; + jm#expect_reference_type; end; - ignore(jm#get_code#get_stack#pop); - jm#get_code#get_stack#push object_sig; + jm#replace_top object_sig; ) ) fields in let def = (fun () -> @@ -2123,13 +2173,13 @@ class tclass_to_jvm gctx c = object(self) val jc = new JvmClass.builder c.cl_path (match c.cl_super with | Some(c,_) -> c.cl_path | None -> - if c.cl_interface || Meta.has Meta.NativeGen c.cl_meta then object_path else haxe_object_path + if (has_class_flag c CInterface) || Meta.has Meta.NativeGen c.cl_meta then object_path else haxe_object_path ) method private set_access_flags = jc#add_access_flag 1; (* public *) - if c.cl_final then jc#add_access_flag 0x10; - if c.cl_interface then begin + if has_class_flag c CFinal then jc#add_access_flag 0x10; + if (has_class_flag c CInterface) then begin jc#add_access_flag 0x200; jc#add_access_flag 0x400; end; @@ -2139,99 +2189,80 @@ class tclass_to_jvm gctx c = object(self) (* TODO: this should be done via Haxe metadata instead of hardcoding it here *) jc#add_annotation retention_path ["value",(AEnum(retention_policy_sig,"RUNTIME"))]; end; + if (has_class_flag c CAbstract) then jc#add_access_flag 0x0400; (* abstract *) if Meta.has Meta.JvmSynthetic c.cl_meta then jc#add_access_flag 0x1000 (* synthetic *) - method private handle_relation_type_params = - let map_type_params t = - let has_type_param = ref false in - let rec loop t = match follow t with - | TInst({cl_kind = KTypeParameter tl},_) -> - has_type_param := true; - begin match tl with - | [t] -> t - | _ -> t_dynamic - end - | _ -> Type.map loop t + method private build_bridges = + let make_bridge name jsig_from jsig_to = + let args_from,ret_from = match jsig_from with + | TMethod(jsigs,jsig) -> jsigs,jsig + | _ -> die "" __LOC__ in - let t = match follow t with - | TFun(tl,tr) -> - let tl = List.map (fun (n,o,t) -> n,o,loop t) tl in - let tr = loop tr in - TFun(tl,tr) - | _ -> - die "" __LOC__ + let args_to,ret_to = match jsig_to with + | TMethod(jsigs,jsig) -> jsigs,jsig + | _ -> die "" __LOC__ in - if !has_type_param then Some t else None + let jm = jc#spawn_method name jsig_from [MPublic;MSynthetic;MBridge] in + gctx.typed_functions#make_forward_method_jsig jc jm name args_from ret_from args_to ret_to in - let make_bridge cf_impl t = - let jsig = jsignature_of_type gctx t in - if not (jc#has_method cf_impl.cf_name jsig) then begin - begin match follow t with - | TFun(tl,tr) -> - let jm = jc#spawn_method cf_impl.cf_name jsig [MPublic;MSynthetic;MBridge] in - jm#load_this; - let jsig_impl = jsignature_of_type gctx cf_impl.cf_type in - let jsigs,_ = match jsig_impl with TMethod(jsigs,jsig) -> jsigs,jsig | _ -> die "" __LOC__ in - List.iter2 (fun (n,_,t) jsig -> - let _,load,_ = jm#add_local n (jsignature_of_type gctx t) VarArgument in - load(); - jm#cast jsig; - ) tl jsigs; - jm#invokevirtual c.cl_path cf_impl.cf_name jsig_impl; - if not (ExtType.is_void (follow tr)) then jm#cast (jsignature_of_type gctx tr); - jm#return; - | _ -> - () - end - end + let maybe_make_bridge name jsig_from jsig_to = + if not (jc#has_method name jsig_from) then make_bridge name jsig_from jsig_to in - let check is_interface cf cf_impl = - match map_type_params cf.cf_type with - | Some t -> - make_bridge cf_impl t - | None -> - (* If we implement an interface with variance, we need a bridge method too (#8528). *) - if is_interface && not (type_iseq cf.cf_type cf_impl.cf_type) then make_bridge cf_impl cf.cf_type + let compare_fields cf_impl cf_super = + let jsig_super = jsignature_of_type gctx cf_super.cf_type in + let jsig_impl = jsignature_of_type gctx cf_impl.cf_type in + if jsig_super <> jsig_impl then + maybe_make_bridge cf_impl.cf_name jsig_super jsig_impl in - let check is_interface cf cf_impl = - check is_interface cf cf_impl; - (* TODO: I think this is incorrect... have to investigate though *) - (* List.iter (fun cf -> check is_interface cf cf_impl) cf.cf_overloads *) + let find_overload map_type c cf = + let tl = match follow (map_type cf.cf_type) with + | TFun(tl,_) -> tl + | _ -> die "" __LOC__ + in + OverloadResolution.resolve_instance_overload false map_type c cf.cf_name (List.map (fun (_,_,t) -> Texpr.Builder.make_null t null_pos) tl) in - let rec loop map_type c_int = - List.iter (fun (c_int,tl) -> - (* Note: We have to apply parent params before child params (#9219). *) - let map_type t = map_type (apply_params c_int.cl_params tl t) in - List.iter (fun cf -> - match cf.cf_kind,raw_class_field (fun cf -> map_type cf.cf_type) c (List.map snd c.cl_params) cf.cf_name with - | (Method (MethNormal | MethInline)),(Some(c',_),_,cf_impl) when c' == c -> - let tl = match follow (map_type cf.cf_type) with - | TFun(tl,_) -> tl - | _ -> die "" __LOC__ - in - begin match find_overload_rec' false map_type c cf.cf_name (List.map (fun (_,_,t) -> Texpr.Builder.make_null t null_pos) tl) with - | Some(_,cf_impl,_) -> check true cf cf_impl - | None -> () - end; - | _ -> - () - ) c_int.cl_ordered_fields; - loop map_type c_int - ) c_int.cl_implements + let if_method f cf = match cf.cf_kind with + | Method _ -> + f cf; + List.iter f cf.cf_overloads + | _ -> + () in - loop (fun t -> t) c; - begin match c.cl_overrides,c.cl_super with - | [],_ -> + begin match c.cl_super with + | Some (c_sup,tl) -> + let map_type = apply_params c_sup.cl_params tl in + let check_override cf = + if has_class_field_flag cf CfOverload then begin match find_overload map_type c_sup cf with + | Some (_,cf_super,_) -> + compare_fields cf cf_super + | None -> + () + end else begin + let _,_,cf_super = raw_class_field (fun cf -> cf.cf_type) c_sup (List.map snd c_sup.cl_params) cf.cf_name in + compare_fields cf cf_super + end + in + let check cf = + if has_class_field_flag cf CfOverride then check_override cf; + in + List.iter (if_method check) c.cl_ordered_fields + | None -> () - | fields,Some(c_sup,tl) -> - List.iter (fun cf_impl -> - match cf_impl.cf_kind,raw_class_field (fun cf -> apply_params c_sup.cl_params tl cf.cf_type) c_sup tl cf_impl.cf_name with - | (Method (MethNormal | MethInline)),(Some(c,tl),_,cf) -> check false cf cf_impl - | _ -> () - ) fields - | _ -> - die "" __LOC__ - end + end; + let rec check_interface map_type (c_int,tl) = + let map_type t = map_type (apply_params c_int.cl_params tl t) in + let check cf = + begin match find_overload map_type c cf with + | Some (_,cf_impl,_) -> + compare_fields cf_impl cf + | None -> + () + end + in + List.iter (if_method check) c_int.cl_ordered_fields; + List.iter (check_interface map_type) c_int.cl_implements + in + List.iter (check_interface (fun t -> t)) c.cl_implements method private set_interfaces = List.iter (fun (c_int,tl) -> @@ -2272,7 +2303,7 @@ class tclass_to_jvm gctx c = object(self) method private generate_implicit_ctors = try - let sm = gctx.preprocessor#get_implicit_ctor c.cl_path in + let sm = gctx.preprocessor#get_implicit_ctor c in PMap.iter (fun _ (c,cf) -> let cmode = get_construction_mode c cf in let jm = jc#spawn_method (if cmode = ConstructInit then "" else "new") (jsignature_of_type gctx cf.cf_type) [MPublic] in @@ -2334,11 +2365,12 @@ class tclass_to_jvm gctx c = object(self) gctx.current_field_info <- gctx.preprocessor#get_field_info cf.cf_meta; let jsig = jsignature_of_type gctx cf.cf_type in let flags = if Meta.has Meta.Private cf.cf_meta then [MPrivate] else if Meta.has Meta.Protected cf.cf_meta then [MProtected] else [MPublic] in - let flags = if c.cl_interface then MAbstract :: flags else flags in + let flags = if (has_class_flag c CInterface) then MAbstract :: flags else flags in let flags = if mtype = MStatic then MethodAccessFlags.MStatic :: flags else flags in let flags = if has_class_field_flag cf CfFinal then MFinal :: flags else flags in let flags = if Meta.has Meta.JvmSynthetic cf.cf_meta then MSynthetic :: flags else flags in let flags = if Meta.has Meta.NativeJni cf.cf_meta then MNative :: flags else flags in + let flags = if (has_class_field_flag cf CfAbstract) then MAbstract :: flags else flags in let name,scmode,flags = match mtype with | MConstructor -> let rec has_super_ctor c = match c.cl_super with @@ -2436,10 +2468,13 @@ class tclass_to_jvm gctx c = object(self) let field mtype cf = match cf.cf_kind with | Method (MethNormal | MethInline) -> List.iter (fun cf -> - failsafe cf.cf_pos (fun () -> self#generate_method gctx jc c mtype cf); - ) (cf :: List.filter (fun cf -> Meta.has Meta.Overload cf.cf_meta) cf.cf_overloads) + self#generate_method gctx jc c mtype cf + ) (cf :: List.filter (fun cf -> has_class_field_flag cf CfOverload) cf.cf_overloads) | _ -> - if not c.cl_interface && is_physical_field cf then failsafe cf.cf_pos (fun () -> self#generate_field gctx jc c mtype cf) + if not (has_class_flag c CInterface) && is_physical_field cf then self#generate_field gctx jc c mtype cf + in + let field mtype cf = + run_timed gctx true cf.cf_name (fun () -> field mtype cf) in Option.may (fun (c2,e) -> if c2 == c then self#generate_main e) gctx.entry_point; List.iter (field MStatic) c.cl_ordered_statics; @@ -2459,7 +2494,17 @@ class tclass_to_jvm gctx c = object(self) end method private generate_signature = - jc#set_type_parameters (List.map fst c.cl_params); + jc#set_type_parameters (List.map (fun (n,t) -> + let jsigs = match follow t with + | TInst({cl_kind = KTypeParameter tl},_) -> + List.map (fun t -> + get_boxed_type (jsignature_of_type gctx t) + ) tl + | _ -> + [] + in + (n,jsigs) + ) c.cl_params); match c.cl_super with | Some(c,tl) -> jc#set_super_parameters (List.map (jtype_argument_of_type gctx []) tl) | _ -> () @@ -2468,22 +2513,25 @@ class tclass_to_jvm gctx c = object(self) AnnotationHandler.generate_annotations (jc :> JvmBuilder.base_builder) c.cl_meta; jc#add_annotation (["haxe";"jvm";"annotation"],"ClassReflectionInformation") (["hasSuperClass",(ABool (c.cl_super <> None))]) - method generate = + method private do_generate = self#set_access_flags; jc#set_source_file c.cl_pos.pfile; - self#generate_fields; + run_timed gctx true "fields" (fun () -> self#generate_fields); self#set_interfaces; - if not c.cl_interface then begin + if not (has_class_flag c CInterface) then begin self#generate_empty_ctor; self#generate_implicit_ctors; - self#handle_relation_type_params; + self#build_bridges; end; self#generate_signature; - if not (Meta.has Meta.NativeGen c.cl_meta) && not c.cl_interface then + if gctx.dynamic_level > 0 && not (Meta.has Meta.NativeGen c.cl_meta) && not (has_class_flag c CInterface) then generate_dynamic_access gctx jc (List.map (fun cf -> cf.cf_name,jsignature_of_type gctx cf.cf_type,cf.cf_kind) c.cl_ordered_fields) false; self#generate_annotations; let jc = jc#export_class gctx.default_export_config in - write_class gctx.jar c.cl_path jc + write_class gctx c.cl_path jc + + method generate = + run_timed gctx true (s_type_path c.cl_path) (fun () -> self#do_generate) end let generate_class gctx c = @@ -2494,34 +2542,45 @@ let generate_enum_equals gctx (jc_ctor : JvmClass.builder) = let jm_equals,load = generate_equals_function jc_ctor (haxe_enum_sig object_sig) in let code = jm_equals#get_code in let jm_equals_handler = new texpr_to_jvm gctx jc_ctor jm_equals (Some TBool) in - let is_maybe_enum jsig = match jsig with - | TObject _ | TTypeParameter _ -> true - | _ -> false + let is_haxe_enum jsig = match jsig with + | TObject(path,_) -> + Hashtbl.mem gctx.enum_paths path + | _ -> + false + in + let compare_whatever jsig = + jm_equals#invokestatic haxe_jvm_path "maybeEnumEq" (method_sig [object_sig;object_sig] (Some TBool)); + jm_equals#if_then + (code#if_ CmpNe) + (fun () -> + code#bconst false; + jm_equals#return; + ) + in + let compare_haxe_enum jsig = + jm_equals#invokestatic haxe_type_path "enumEq" (method_sig [object_sig;object_sig] (Some TBool)); + jm_equals#if_then + (code#if_ CmpNe) + (fun () -> + code#bconst false; + jm_equals#return; + ) + in + let compare_standard jsig = + jm_equals#if_then + (jm_equals_handler#apply_cmp (jm_equals_handler#do_compare CmpNe)) + (fun () -> + code#bconst false; + jm_equals#return; + ); in let compare jsig = - if is_maybe_enum jsig then begin - jm_equals#if_then_else - (jm_equals_handler#apply_cmp (jm_equals_handler#do_compare CmpNe)) - (fun () -> - jm_equals#invokestatic haxe_jvm_path "enumEq" (method_sig [object_sig;object_sig] (Some TBool)); - jm_equals#if_then - (code#if_ CmpNe) - (fun () -> - code#bconst false; - jm_equals#return; - ) - ) - (fun () -> - code#pop; - code#pop; - ) - end else - jm_equals#if_then - (jm_equals_handler#apply_cmp (jm_equals_handler#do_compare CmpNe)) - (fun () -> - code#bconst false; - jm_equals#return; - ); + if NativeSignatures.is_dynamic_at_runtime jsig then + compare_whatever jsig + else if is_haxe_enum jsig then + compare_haxe_enum jsig + else + compare_standard jsig in load(); jm_equals#invokevirtual java_enum_path "ordinal" (method_sig [] (Some TInt)); @@ -2531,10 +2590,8 @@ let generate_enum_equals gctx (jc_ctor : JvmClass.builder) = let compare_field n jsig = load(); jm_equals#getfield jc_ctor#get_this_path n jsig; - if is_maybe_enum jsig then code#dup; jm_equals#load_this; jm_equals#getfield jc_ctor#get_this_path n jsig; - if is_maybe_enum jsig then code#dup_x1; compare jsig; in jm_equals,compare_field @@ -2575,7 +2632,7 @@ let generate_enum gctx en = jm_ctor#string ef.ef_name; jm_ctor#call_super_ctor ConstructInit jsig_enum_ctor; List.iter (fun (n,jsig) -> - jm_ctor#add_argument_and_field n jsig + jm_ctor#add_argument_and_field n jsig [FdPublic;FdFinal] ) args; jm_ctor#return; jc_ctor#add_annotation (["haxe";"jvm";"annotation"],"EnumValueReflectionInformation") (["argumentNames",AArray (List.map (fun (name,_) -> AString name) args)]); @@ -2597,7 +2654,7 @@ let generate_enum gctx en = end; jc_ctor end in - write_class gctx.jar jc_ctor#get_this_path (jc_ctor#export_class gctx.default_export_config); + write_class gctx jc_ctor#get_this_path (jc_ctor#export_class gctx.default_export_config); begin match args with | [] -> (* Create static field for ctor without args *) @@ -2646,31 +2703,18 @@ let generate_enum gctx en = end; AnnotationHandler.generate_annotations (jc_enum :> JvmBuilder.base_builder) en.e_meta; jc_enum#add_annotation (["haxe";"jvm";"annotation"],"EnumReflectionInformation") (["constructorNames",AArray names]); - write_class gctx.jar en.e_path (jc_enum#export_class gctx.default_export_config) - -let generate_abstract gctx a = - let super_path = object_path in - let jc = new JvmClass.builder a.a_path super_path in - jc#add_access_flag 1; (* public *) - let jc = jc#export_class gctx.default_export_config in - write_class gctx.jar a.a_path jc - -let debug_path path = match path with - (* | ([],"Main") | (["haxe";"jvm"],_) -> true *) - | (["haxe";"lang"],_) -> false (* Old Haxe/Java stuff that's weird *) - | _ -> true + write_class gctx en.e_path (jc_enum#export_class gctx.default_export_config) let generate_module_type ctx mt = - failsafe (t_infos mt).mt_pos (fun () -> - match mt with - | TClassDecl c when not c.cl_extern && debug_path c.cl_path -> generate_class ctx c + match mt with + | TClassDecl c when not (has_class_flag c CExtern) -> generate_class ctx c | TEnumDecl en when not en.e_extern -> generate_enum ctx en | _ -> () - ) let generate_anons gctx = - Hashtbl.iter (fun path pfm -> - let fields = convert_fields gctx pfm.pfm_fields in + Hashtbl.iter (fun _ pfm -> + let path = pfm.pfm_path in + let fields = convert_fields gctx pfm in let jc = new JvmClass.builder path haxe_dynamic_object_path in jc#add_access_flag 0x1; begin @@ -2679,7 +2723,7 @@ let generate_anons gctx = jm_ctor#get_code#aconst_null haxe_empty_constructor_sig; jm_ctor#call_super_ctor ConstructInit (method_sig [haxe_empty_constructor_sig] None); List.iter (fun (name,jsig) -> - jm_ctor#add_argument_and_field name jsig; + jm_ctor#add_argument_and_field name jsig [FdPublic] ) fields; jm_ctor#return; end; @@ -2702,6 +2746,7 @@ let generate_anons gctx = load(); jm_fields#return end; + (* This has to run even with dynamic_level = 0 because the entire DynamicObject logic depends on it. *) generate_dynamic_access gctx jc (List.map (fun (name,jsig) -> name,jsig,Var {v_write = AccNormal;v_read = AccNormal}) fields) true; begin match gctx.typedef_interfaces#get_interface_class path with | None -> @@ -2732,28 +2777,35 @@ let generate_anons gctx = jm#return ) c.cl_ordered_fields end; - write_class gctx.jar path (jc#export_class gctx.default_export_config) - ) gctx.anon_identification#get_anons + write_class gctx path (jc#export_class gctx.default_export_config) + ) gctx.anon_identification#get_pfms let generate_typed_functions gctx = let jc_function = gctx.typed_functions#generate in - write_class gctx.jar jc_function#get_this_path (jc_function#export_class gctx.default_export_config); + write_class gctx jc_function#get_this_path (jc_function#export_class gctx.default_export_config); let jc_varargs = gctx.typed_functions#generate_var_args in - write_class gctx.jar jc_varargs#get_this_path (jc_varargs#export_class gctx.default_export_config); + write_class gctx jc_varargs#get_this_path (jc_varargs#export_class gctx.default_export_config); let jc_closure_dispatch = gctx.typed_functions#generate_closure_dispatch in - write_class gctx.jar jc_closure_dispatch#get_this_path (jc_closure_dispatch#export_class gctx.default_export_config) + write_class gctx jc_closure_dispatch#get_this_path (jc_closure_dispatch#export_class gctx.default_export_config) module Preprocessor = struct let make_root path = ["haxe";"root"],snd path + let has_primary_type m = + List.exists (fun mt -> snd (t_infos mt).mt_path = snd m.m_path) m.m_types + let check_path mt = (* don't rewrite if there's an explicit @:native *) if Meta.has Meta.Native mt.mt_meta then () - else if mt.mt_private then begin + else if mt.mt_private && has_primary_type mt.mt_module then begin let m = mt.mt_module in - mt.mt_path <- (fst m.m_path,Printf.sprintf "%s$%s" (snd m.m_path) (snd mt.mt_path)) + let pack = match fst m.m_path with + | [] -> ["haxe";"root"] + | pack -> pack + in + mt.mt_path <- (pack,Printf.sprintf "%s$%s" (snd m.m_path) (snd mt.mt_path)) end else if fst mt.mt_path = [] then mt.mt_path <- make_root mt.mt_path @@ -2770,7 +2822,7 @@ module Preprocessor = struct List.iter (fun m -> List.iter (fun mt -> match mt with - | TClassDecl ({cl_interface=true} as c) when has_runtime_meta c.cl_meta -> + | TClassDecl c when has_runtime_meta c.cl_meta && has_class_flag c CInterface -> () (* TODO: run-time interface metadata is a problem (issue #2042) *) | TClassDecl _ | TEnumDecl _ -> check_path (t_infos mt); @@ -2785,12 +2837,12 @@ module Preprocessor = struct List.iter (fun mt -> match mt with | TClassDecl c -> - if debug_path c.cl_path && not c.cl_interface then gctx.preprocessor#preprocess_class c + if not (has_class_flag c CInterface) then gctx.preprocessor#preprocess_class c | _ -> () ) gctx.com.types; (* find typedef-interface implementations *) List.iter (fun mt -> match mt with - | TClassDecl c when debug_path c.cl_path && not c.cl_interface && not c.cl_extern -> + | TClassDecl c when not (has_class_flag c CInterface) && not (has_class_flag c CExtern) -> gctx.typedef_interfaces#process_class c; | _ -> () @@ -2799,14 +2851,9 @@ end let generate jvm_flag com = let path = FilePath.parse com.file in - let jar_name,manifest_suffix,entry_point = match get_entry_point com with - | Some (jarname,cl,expr) -> - let pack = match fst cl.cl_path with - | [] -> ["haxe";"root"] - | pack -> pack - in - jarname,"\nMain-Class: " ^ (s_type_path (pack,snd cl.cl_path)), Some (cl,expr) - | None -> "jar","",None + let jar_name,entry_point = match get_entry_point com with + | Some (jarname,cl,expr) -> jarname, Some (cl,expr) + | None -> "jar",None in let jar_dir,jar_path = if jvm_flag then begin match path.file_name with @@ -2827,6 +2874,18 @@ let generate jvm_flag com = jar_dir,jar_path end in let anon_identification = new tanon_identification haxe_dynamic_object_path in + let compression_level = try + int_of_string (Define.defined_value com.defines Define.JvmCompressionLevel) + with _ -> + 6 + in + if compression_level < 0 || compression_level > 9 then failwith "Invalid value for -D jvm.compression-level: Must be >=0 and <= 9"; + let dynamic_level = try + int_of_string (Define.defined_value com.defines Define.JvmDynamicLevel) + with _ -> + 1 + in + if dynamic_level < 0 || dynamic_level > 2 then failwith "Invalid value for -D jvm.dynamic-level: Must be >=0 and <= 2"; let gctx = { com = com; jar = Zip.open_out jar_path; @@ -2839,14 +2898,19 @@ let generate jvm_flag com = typedef_interfaces = Obj.magic (); typed_functions = new JvmFunctions.typed_functions; closure_paths = Hashtbl.create 0; + enum_paths = Hashtbl.create 0; current_field_info = None; default_export_config = { export_debug = true; - } + }; + detail_times = Common.Define.raw_defined com.defines "jvm-times"; + timer = new Timer.timer ["generate";"java"]; + jar_compression_level = compression_level; + dynamic_level = dynamic_level; } in gctx.anon_identification <- anon_identification; gctx.preprocessor <- new preprocessor com.basic (jsignature_of_type gctx); - gctx.typedef_interfaces <- new typedef_interfaces 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; let class_paths = ExtList.List.filter_map (fun java_lib -> if java_lib#has_flag NativeLibraries.FlagIsStd || java_lib#has_flag FlagIsExtern then None @@ -2863,17 +2927,9 @@ let generate jvm_flag com = Some (Printf.sprintf "lib/%s" name) end ) com.native_libs.java_libs in - let manifest_content = - "Manifest-Version: 1.0\n" ^ - (match class_paths with [] -> "" | _ -> "Class-Path: " ^ (String.concat " " class_paths ^ "\n")) ^ - "Created-By: Haxe (Haxe Foundation)" ^ - manifest_suffix ^ - "\n\n" - in - Zip.add_entry manifest_content gctx.jar "META-INF/MANIFEST.MF"; Hashtbl.iter (fun name v -> let filename = Codegen.escape_res_name name true in - Zip.add_entry v gctx.jar filename; + Zip.add_entry ~level:gctx.jar_compression_level v gctx.jar filename; ) com.resources; let generate_real_types () = List.iter (generate_module_type gctx) com.types; @@ -2881,9 +2937,19 @@ let generate jvm_flag com = let generate_typed_interfaces () = Hashtbl.iter (fun _ c -> generate_module_type gctx (TClassDecl c)) gctx.typedef_interfaces#get_interfaces; in - Std.finally (Timer.timer ["generate";"java";"preprocess"]) Preprocessor.preprocess gctx; - Std.finally (Timer.timer ["generate";"java";"real types"]) generate_real_types (); - Std.finally (Timer.timer ["generate";"java";"typed interfaces"]) generate_typed_interfaces (); - Std.finally (Timer.timer ["generate";"java";"anons"]) generate_anons gctx; - Std.finally (Timer.timer ["generate";"java";"typed functions"]) generate_typed_functions gctx; + 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); + + let manifest_content = + "Manifest-Version: 1.0\n" ^ + (match class_paths with [] -> "" | _ -> "Class-Path: " ^ (String.concat " " class_paths ^ "\n")) ^ + "Created-By: Haxe (Haxe Foundation)" ^ + (Option.map_default (fun (cl,_) -> "\nMain-Class: " ^ (s_type_path cl.cl_path)) "" entry_point) ^ + "\n\n" + in + Zip.add_entry ~level:gctx.jar_compression_level manifest_content gctx.jar "META-INF/MANIFEST.MF"; + Zip.close_out gctx.jar \ No newline at end of file diff --git a/src/generators/genlua.ml b/src/generators/genlua.ml index 39dcd37f..5b6605e3 100644 --- a/src/generators/genlua.ml +++ b/src/generators/genlua.ml @@ -130,7 +130,7 @@ let ident s = if Hashtbl.mem kwds s then "_" ^ s else s let anon_field s = if Hashtbl.mem kwds s || not (valid_lua_ident s) then "['" ^ (s_escape_lua s) ^ "']" else s let static_field c s = match s with - | "length" | "name" when not c.cl_extern || Meta.has Meta.HxGen c.cl_meta-> "._hx" ^ s + | "length" | "name" when not (has_class_flag c CExtern) || Meta.has Meta.HxGen c.cl_meta-> "._hx" ^ s | s -> field s let has_feature ctx = Common.has_feature ctx.com @@ -185,13 +185,32 @@ let rec concat ctx s f = function spr ctx s; concat ctx s f l +(* create a __lua__ call *) +let mk_lua_code com code args t pos = + let lua_local = mk (TIdent "__lua__") t_dynamic pos in + let code_const = Texpr.Builder.make_string com code pos in + mk (TCall (lua_local, code_const :: args)) t pos + +let inject_rest_args ctx args e = + match List.rev args with + | (v,_) :: _ when ExtType.is_rest (follow v.v_type) -> + let rest = mk (TLocal v) v.v_type v.v_pos in + let init_rest = mk_lua_code ctx.com.basic "local {0} = {...}" [rest] ctx.com.basic.tvoid v.v_pos in + (match e.eexpr with + | TBlock el -> + { e with eexpr = TBlock (init_rest :: el) } + | _ -> + { e with eexpr = TBlock [init_rest; e] } + ) + | _ -> e + let fun_block ctx f p = - let e = List.fold_left (fun e (a,c) -> + let fn_body = inject_rest_args ctx f.tf_args f.tf_expr in + List.fold_left (fun e (a,c) -> match c with | None | Some {eexpr = TConst TNull} -> e | Some c -> Type.concat (Texpr.set_default ctx.com.basic a c p) e - ) f.tf_expr f.tf_args in - e + ) fn_body f.tf_args let open_block ctx = let oldt = ctx.tabs in @@ -223,12 +242,6 @@ let index_of f l = in find l 0 -(* create a __lua__ call *) -let mk_lua_code com code args t pos = - let lua_local = mk (TIdent "__lua__") t_dynamic pos in - let code_const = Texpr.Builder.make_string com code pos in - mk (TCall (lua_local, code_const :: args)) t pos - (* create a multi-return boxing call for given expr *) let mk_mr_box ctx e = let s_fields = @@ -618,13 +631,25 @@ and check_multireturn_param ctx t pos = | _ -> (); +(* for declaring identifiers in values/blocks *) +and lua_ident_name a = + match a.v_name, a.v_kind, a.v_type with + | "this", _, _ -> "self"; + | _, _, _ -> ident a.v_name; + + +(* for declaring arguments in function defintions *) +and lua_arg_name(a,_) = + match a.v_name, a.v_kind, a.v_type with + | "this", _, _ -> "self"; + | _, _, TAbstract({a_path=["haxe"],"Rest" },_) -> "..."; + | _, _, _ -> ident a.v_name; + and gen_expr ?(local=true) ctx e = begin match e.eexpr with TConst c -> gen_constant ctx e.epos c; - | TLocal v when v.v_name = "this" -> - spr ctx "self"; - | TLocal v -> spr ctx (ident v.v_name) + | TLocal v -> spr ctx (lua_ident_name v); | TArray (e1,{ eexpr = TConst (TString s) }) when valid_lua_ident s && (match e1.eexpr with TConst (TInt _|TFloat _) -> false | _ -> true) -> gen_value ctx e1; spr ctx (field s) @@ -724,7 +749,7 @@ and gen_expr ?(local=true) ctx e = begin let old = ctx.in_value, ctx.in_loop in ctx.in_value <- None; ctx.in_loop <- false; - print ctx "function(%s) " (String.concat "," (List.map ident (List.map arg_name f.tf_args))); + print ctx "function(%s) " (String.concat "," (List.map lua_arg_name f.tf_args)); let fblock = fun_block ctx f e.epos in (match fblock.eexpr with | TBlock el -> @@ -906,6 +931,11 @@ and gen_expr ?(local=true) ctx e = begin spr ctx "_hx_bit.bnot("; gen_value ctx e; spr ctx ")"; + | TUnop (Spread,Prefix,e) -> + add_feature ctx "use._hx_table"; + spr ctx "_hx_table.unpack("; + gen_value ctx e; + spr ctx ")"; | TUnop (op,Ast.Prefix,e) -> spr ctx (Ast.s_unop op); gen_value ctx e @@ -1079,7 +1109,7 @@ and gen_anon_value ctx e = let old = ctx.in_value, ctx.in_loop in ctx.in_value <- None; ctx.in_loop <- false; - print ctx "function(%s) " (String.concat "," ("self" :: (List.map ident (List.map arg_name f.tf_args)))); + print ctx "function(%s) " (String.concat "," ("self" :: (List.map lua_arg_name f.tf_args))); let fblock = fun_block ctx f e.epos in (match fblock.eexpr with | TBlock el -> @@ -1452,7 +1482,7 @@ and can_gen_class_field ctx = function let check_multireturn ctx c = match c with | _ when Meta.has Meta.MultiReturn c.cl_meta -> - if not c.cl_extern then + if not (has_class_flag c CExtern) then error "MultiReturns must be externs" c.cl_pos else if List.length c.cl_ordered_statics > 0 then error "MultiReturns must not contain static fields" c.cl_pos @@ -1510,7 +1540,7 @@ let gen_class_field ctx c f = ctx.in_value <- None; ctx.in_loop <- false; print ctx " = function"; - print ctx "(%s) " (String.concat "," ("self" :: List.map ident (List.map arg_name f2.tf_args))); + print ctx "(%s) " (String.concat "," ("self" ::(List.map lua_arg_name f2.tf_args))); let fblock = fun_block ctx f2 e.epos in (match fblock.eexpr with | TBlock el -> @@ -1572,7 +1602,7 @@ let generate_class ctx c = let old = ctx.in_value, ctx.in_loop in ctx.in_value <- None; ctx.in_loop <- false; - print ctx "function(%s) " (String.concat "," (List.map ident (List.map arg_name f.tf_args))); + print ctx "function(%s) " (String.concat "," (List.map lua_arg_name f.tf_args)); let fblock = fun_block ctx f e.epos in (match fblock.eexpr with | TBlock el -> @@ -1580,13 +1610,13 @@ let generate_class ctx c = newline ctx; if not (has_prototype ctx c) then println ctx "local self = _hx_new()" else println ctx "local self = _hx_new(%s.prototype)" p; - println ctx "%s.super(%s)" p (String.concat "," ("self" :: (List.map ident (List.map arg_name f.tf_args)))); + println ctx "%s.super(%s)" p (String.concat "," ("self" :: (List.map lua_arg_name f.tf_args))); if p = "String" then println ctx "self = string"; spr ctx "return self"; bend(); newline ctx; spr ctx "end"; newline ctx; let bend = open_block ctx in - print ctx "%s.super = function(%s) " p (String.concat "," ("self" :: (List.map ident (List.map arg_name f.tf_args)))); + print ctx "%s.super = function(%s) " p (String.concat "," ("self" :: (List.map lua_arg_name f.tf_args))); List.iter (gen_block_element ctx) el; bend(); newline ctx; @@ -1766,9 +1796,9 @@ let generate_type ctx = function (* A special case for Std because we do not want to generate it if it's empty. *) if p = "Std" && c.cl_ordered_statics = [] then () - else if (not c.cl_extern) && Meta.has Meta.LuaDotMethod c.cl_meta then + else if (not (has_class_flag c CExtern)) && Meta.has Meta.LuaDotMethod c.cl_meta then error "LuaDotMethod is valid for externs only" c.cl_pos - else if not c.cl_extern then + else if not (has_class_flag c CExtern) then generate_class ctx c; check_multireturn ctx c; | TEnumDecl e -> @@ -1778,7 +1808,7 @@ let generate_type ctx = function let generate_type_forward ctx = function | TClassDecl c -> - if not c.cl_extern then + if not (has_class_flag c CExtern) then begin let p = s_path ctx c.cl_path in let l,c = c.cl_path in @@ -1825,7 +1855,7 @@ let alloc_ctx com = ctx.type_accessor <- (fun t -> let p = t_path t in match t with - | TClassDecl ({ cl_extern = true } as c) when not (Meta.has Meta.LuaRequire c.cl_meta) + | TClassDecl c when (has_class_flag c CExtern) && not (Meta.has Meta.LuaRequire c.cl_meta) -> dot_path p | TEnumDecl { e_extern = true } -> s_path ctx p diff --git a/src/generators/genneko.ml b/src/generators/genneko.ml index f78901ba..cd085792 100644 --- a/src/generators/genneko.ml +++ b/src/generators/genneko.ml @@ -189,6 +189,7 @@ and gen_unop ctx p op flag e = | Not -> call p (builtin p "not") [gen_expr ctx e] | Neg -> (EBinop ("-",int p 0, gen_expr ctx e),p) | NegBits -> (EBinop ("-",int p (-1), gen_expr ctx e),p) + | Spread -> die ~p:e.epos "Unhandled spread operator" __LOC__ and gen_call ctx p e el = match e.eexpr , el with @@ -222,7 +223,7 @@ and gen_expr ctx e = | TIdent s when s.[0] = '$' -> (EConst (Builtin (String.sub s 1 (String.length s - 1))),p) | TLocal v -> - if v.v_capture then + if has_var_flag v VCaptured then (EArray (ident p v.v_name,int p 0),p) else ident p v.v_name @@ -266,7 +267,7 @@ and gen_expr ctx e = call p (field p (ident p "Array") "new1") [array p (List.map (gen_expr ctx) el); int p (List.length el)] | TCall (e,el) -> gen_call ctx p e el - | TNew (c,_,params) -> + | TNew (c,tl,params) -> call p (field p (gen_type_path p c.cl_path) "new") (List.map (gen_expr ctx) params) | TUnop (op,flag,e) -> gen_unop ctx p op flag e @@ -274,13 +275,13 @@ and gen_expr ctx e = (EVars ( let e = (match eo with | None -> - if v.v_capture then + if has_var_flag v VCaptured then Some (call p (builtin p "array") [null p]) else None | Some e -> let e = gen_expr ctx e in - if v.v_capture then + if has_var_flag v VCaptured then Some (call p (builtin p "array") [e]) else Some e @@ -289,7 +290,7 @@ and gen_expr ctx e = ),p) | TFunction f -> let inits = List.fold_left (fun acc (a,c) -> - let acc = if a.v_capture then + let acc = if has_var_flag a VCaptured then (EBinop ("=",ident p a.v_name,call p (builtin p "array") [ident p a.v_name]),p) :: acc else acc @@ -307,7 +308,7 @@ and gen_expr ctx e = let it = gen_expr ctx it in let e = gen_expr ctx e in let next = call p (field p (ident p "@tmp") "next") [] in - let next = (if v.v_capture then call p (builtin p "array") [next] else next) in + let next = (if has_var_flag v VCaptured then call p (builtin p "array") [next] else next) in (EBlock [(EVars ["@tmp", Some it],p); (EWhile (call p (field p (ident p "@tmp") "hasNext") [], @@ -341,7 +342,7 @@ and gen_expr ctx e = | Some path -> call p (field p (gen_type_path p (["neko"],"Boot")) "__instanceof") [ident p "@tmp"; gen_type_path p path] ) in let id = ident p "@tmp" in - let id = (if v.v_capture then call p (builtin p "array") [id] else id) in + let id = (if has_var_flag v VCaptured then call p (builtin p "array") [id] else id) in let e = gen_expr ctx e in (EIf (cond,(EBlock [ EVars [v.v_name,Some id],p; @@ -556,7 +557,7 @@ let gen_type ctx t acc = (match c.cl_init with | None -> () | Some e -> ctx.inits <- (c,e) :: ctx.inits); - if c.cl_extern then + if (has_class_flag c CExtern) then acc else gen_class ctx c :: acc @@ -572,7 +573,7 @@ let gen_static_vars ctx t = match t with | TEnumDecl _ | TTypeDecl _ | TAbstractDecl _ -> [] | TClassDecl c -> - if c.cl_extern then + if (has_class_flag c CExtern) then [] else List.fold_right (fun f acc -> @@ -641,7 +642,7 @@ let gen_name ctx acc t = in setname :: setconstrs :: meta @ acc | TClassDecl c -> - if c.cl_extern || (match c.cl_kind with KTypeParameter _ -> true | _ -> false) then + if (has_class_flag c CExtern) || (match c.cl_kind with KTypeParameter _ -> true | _ -> false) then acc else let p = pos ctx c.cl_pos in diff --git a/src/generators/genphp7.ml b/src/generators/genphp7.ml index 01b28322..e288bea5 100644 --- a/src/generators/genphp7.ml +++ b/src/generators/genphp7.ml @@ -80,9 +80,24 @@ type php_generator_context = { (** php.Boot *) pgc_boot : tclass; (** see type_name_used_in_namespace *) - pgc_namespaces_types_cache : (string list, string) Hashtbl.t + pgc_namespaces_types_cache : (string list, string) Hashtbl.t; + (** + List of anon structures declarations found during generating current php file. + The key is a list of fields names. + The value is an auto-generated name for the class representing that anon. + *) + pgc_anons : (string list, string) Hashtbl.t; + (** a buffer to write to the bottom of the current php file (but before "Boot::registerClass()" and "::_hx_init()" calls) *) + pgc_bottom_buffer : Buffer.t; } +(** + Reset the state of the context between before a generating a php file. +*) +let reset_context ctx = + Buffer.clear ctx.pgc_bottom_buffer; + Hashtbl.clear ctx.pgc_anons + (** Get list of keys in Hashtbl *) @@ -93,6 +108,11 @@ let hashtbl_keys tbl = Hashtbl.fold (fun key _ lst -> key :: lst) tbl [] *) let diff_lists list1 list2 = List.filter (fun x -> not (List.mem x list2)) list1 +(** + @return List of items in `list1` which `list2` does contain too +*) +let intersect_lists list1 list2 = List.filter (fun x -> List.mem x list2) list1 + (** Type path of `php.Boot` *) @@ -296,6 +316,11 @@ let is_string expr = ExtType.is_string (follow expr.etype) *) let is_array_type t = match follow t with TInst ({ cl_path = ([], "Array") }, _) -> true | _ -> false +(** + Check if specified type is haxe.Rest +*) +let is_rest_type t = ExtType.is_rest (Type.follow t) + (** Check if specified type represents a function *) @@ -351,10 +376,8 @@ let need_parenthesis_for_binop current parent = Check if specified expression may require dereferencing if used as "temporary expression" *) let needs_dereferencing for_assignment expr = - let rec is_create target_expr = - match (reveal_expr target_expr).eexpr with - | TParenthesis e -> is_create e - | TCast (e, _) -> is_create e + let is_create target_expr = + match (reveal_expr_with_parenthesis target_expr).eexpr with | TNew _ -> for_assignment | TArrayDecl _ -> for_assignment | TObjectDecl _ -> for_assignment @@ -399,13 +422,7 @@ let get_function_signature (field:tclass_field) : (string * bool * Type.t) list let is_sure_scalar (target:Type.t) = match follow target with | TInst ({ cl_path = ([], "String") }, _) -> true - | TAbstract (abstr, _) -> - (match abstr.a_path with - | ([],"Int") -> true - | ([],"Float") -> true - | ([],"Bool") -> true - | _ -> false - ) + | TAbstract ({ a_path = ([], ("Int" | "Float" | "Bool"))}, _) -> true | _ -> false (** @@ -448,7 +465,7 @@ let is_assignment_binop op = *) let is_php_global expr = match expr.eexpr with - | TField (_, FStatic (c, _)) when c.cl_extern -> c.cl_path = ([],"") || Meta.has Meta.PhpGlobal c.cl_meta + | TField (_, FStatic (c, _)) when (has_class_flag c CExtern) -> c.cl_path = ([],"") || Meta.has Meta.PhpGlobal c.cl_meta | _ -> false (** @@ -456,7 +473,7 @@ let is_php_global expr = *) let is_php_class_const expr = match expr.eexpr with - | TField (_, FStatic ({ cl_extern = true }, { cf_meta = meta; cf_kind = Var _ })) -> + | TField (_, FStatic (c, { cf_meta = meta; cf_kind = Var _ })) when (has_class_flag c CExtern) -> Meta.has Meta.PhpClassConst meta | _ -> false @@ -475,18 +492,10 @@ let is_enum_constructor_with_args (constructor:tenum_field) = let rec sure_extends_extern (target:Type.t) = match follow target with | TInst ({ cl_path = ([], "String") }, _) -> false - | TInst ({ cl_extern = true }, _) -> true + | TInst (c, _) when (has_class_flag c CExtern) -> true | TInst ({ cl_super = Some (tsuper, params) }, _) -> sure_extends_extern (TInst (tsuper,params)) | _ -> false -(** - @return `opt` value or `default` if `opt` is None -*) -let get_option_value (opt:'a option) default = - match opt with - | None -> default - | Some value -> value - (** @param path Something like [ "/some/path/first_dir_to_create"; "nested_level1"; "nested_level2" ] @return String representation of created path (E.g. "/some/path/first_dir_to_create/nested_level1/nested_level2") @@ -532,12 +541,12 @@ let get_full_type_name ?(escape=false) ?(omit_first_slash=false) (type_path:path (** @return Short type name. E.g. returns "Test" for (["example"], "Test") *) -let get_type_name (type_path:path) = match type_path with (_, type_name) -> type_name +let get_type_name (type_path:path) = snd type_path (** @return E.g. returns ["example"] for (["example"], "Test") *) -let get_module_path (type_path:path) = match type_path with (module_path, _) -> module_path +let get_module_path (type_path:path) = fst type_path (** @return PHP visibility keyword. @@ -586,6 +595,25 @@ let fix_tsignature_args args = (fun (name,_,t) -> (name,false,t)) args +(** + Inserts `null`s if there are missing optional args before empty rest arguments. +*) +let fix_call_args callee_type exprs = + match follow callee_type with + | TFun (args,_) -> + (match List.rev args with + | (_,_,t) :: args_rev when is_rest_type t && List.length args_rev > List.length exprs -> + let rec loop args exprs = + match args, exprs with + | [], _ | [_], _ -> exprs + | (_,_,t) :: args, [] -> (mk (TConst TNull) t null_pos) :: loop args exprs + | _ :: args, e :: exprs -> e :: loop args exprs + in + loop args exprs + | _ -> exprs + ) + | _ -> exprs + (** Escapes all "$" chars and encloses `str` into double quotes *) @@ -695,11 +723,7 @@ let is_binop expr = match expr.eexpr with TBinop _ -> true | _ -> false *) let is_binop_assign expr = match expr.eexpr with - | TBinop (operation, _, _) -> - (match operation with - | OpAssign | OpAssignOp _ -> true - | _ -> false - ) + | TBinop ((OpAssign | OpAssignOp _), _, _) -> true | _ -> false (** @@ -710,6 +734,15 @@ let is_access expr = | TField _ | TArray _ -> true | _ -> false +(** + Check if specified field access is an access to the field `Array.arr` + It's a private field of the php-specific implementation of Haxe Array. +*) +let is_array_arr faccess = + match faccess with + | FInstance ({ cl_path = [],"Array" }, _, { cf_name = "arr" }) -> true + | _ -> false + (** Indicates if `expr` is actually a call to Haxe->PHP magic function @see http://old.haxe.org/doc/advanced/magic#php-magic @@ -916,14 +949,14 @@ class virtual type_wrapper (type_path:path) (meta:metadata) (needs_generation:bo *) class class_wrapper (cls) = object (self) - inherit type_wrapper cls.cl_path cls.cl_meta (not cls.cl_extern) + inherit type_wrapper cls.cl_path cls.cl_meta (not (has_class_flag cls CExtern)) (** Indicates if class initialization method should be executed upon class loaded *) method needs_initialization = (* Interfaces may need initialization only for RTTI meta data. But that meta is written in `class_wrapper#write_rtti_meta` *) - if cls.cl_interface then + if (has_class_flag cls CInterface) then false else match cls.cl_init with @@ -958,7 +991,7 @@ class class_wrapper (cls) = If current type requires some additional type to be generated *) method get_service_type : module_type option = - if not cls.cl_extern then + if not (has_class_flag cls CExtern) then None else match cls.cl_init with @@ -970,16 +1003,15 @@ class class_wrapper (cls) = in let additional_cls = { cls with - cl_extern = false; cl_path = path; cl_fields = PMap.create (fun a b -> 0); cl_statics = PMap.create (fun a b -> 0); cl_ordered_fields = []; cl_ordered_statics = []; cl_constructor = None; - cl_overrides = []; cl_init = Some body } in + remove_class_flag additional_cls CExtern; Some (TClassDecl additional_cls) end @@ -1044,64 +1076,40 @@ class abstract_wrapper (abstr) = end (** - type_wrapper for classes + type_wrapper from table *) -let classes = Hashtbl.create 1000 -let get_class_wrapper cls : type_wrapper = +let get_stored_wrapper tbl wrap key : type_wrapper = try - let wrapper = Hashtbl.find classes cls in + let wrapper = Hashtbl.find tbl key in + wrapper + with Not_found -> + let wrapper = wrap key in + Hashtbl.add tbl key wrapper; wrapper - with - | Not_found -> - let wrapper = new class_wrapper cls in - Hashtbl.add classes cls wrapper; - wrapper - | e -> raise e + +(** + type_wrapper for classes +*) +let classes = Hashtbl.create 1000 +let get_class_wrapper = get_stored_wrapper classes (fun cls -> new class_wrapper cls) (** type_wrapper for enums *) let enums = Hashtbl.create 200 -let get_enum_wrapper enm : type_wrapper= - try - let wrapper = Hashtbl.find enums enm in - wrapper - with - | Not_found -> - let wrapper = new enum_wrapper enm in - Hashtbl.add enums enm wrapper; - wrapper - | e -> raise e +let get_enum_wrapper = get_stored_wrapper enums (fun enm -> new enum_wrapper enm) (** type_wrapper for typedefs *) let typedefs = Hashtbl.create 200 -let get_typedef_wrapper typedef : type_wrapper = - try - let wrapper = Hashtbl.find typedefs typedef in - wrapper - with - | Not_found -> - let wrapper = new typedef_wrapper typedef in - Hashtbl.add typedefs typedef wrapper; - wrapper - | e -> raise e +let get_typedef_wrapper = get_stored_wrapper typedefs (fun typedef -> new typedef_wrapper typedef) (** type_wrapper for abstracts *) let abstracts = Hashtbl.create 200 -let get_abstract_wrapper abstr : type_wrapper = - try - let wrapper = Hashtbl.find abstracts abstr in - wrapper - with - | Not_found -> - let wrapper = new abstract_wrapper abstr in - Hashtbl.add abstracts abstr wrapper; - wrapper - | e -> raise e +let get_abstract_wrapper = get_stored_wrapper abstracts (fun abstr -> new abstract_wrapper abstr) (** Returns wrapper for module_type. @@ -1142,19 +1150,6 @@ let type_name_used_in_namespace ctx type_path as_name namespace = List.mem as_name types && (namespace, as_name) <> type_path -(** - Simple list intersection implementation. - @return A list of values existing in each of source lists. -*) -let rec list_intersect list1 list2 = - match list2 with - | [] -> [] - | item :: rest -> - if List.mem item list1 then - item :: (list_intersect list1 rest) - else - list_intersect list1 rest - (** Class to simplify collecting lists of declared and used local vars. Collected data is needed to generate closures correctly. @@ -1199,7 +1194,7 @@ class local_vars = used_locals <- rest_used; declared_locals <- rest_declared; List.iter self#used higher_vars; - let captured_vars = list_intersect declared_vars (hashtbl_keys captured_locals) in + let captured_vars = intersect_lists declared_vars (hashtbl_keys captured_locals) in List.iter (fun name -> Hashtbl.remove captured_locals name) declared_vars; (higher_vars, declared_vars, captured_vars) (** @@ -1311,6 +1306,11 @@ class code_writer (ctx:php_generator_context) hx_type_path php_name = Get indentation level (starting from zero for no indentation) *) method get_indentation = String.length indentation + (** + Set indentation level (starting from zero for no indentation) + *) + method set_indentation level = + indentation <- String.make level '\t' (** Specify local var name declared in current scope *) @@ -1326,7 +1326,7 @@ class code_writer (ctx:php_generator_context) hx_type_path php_name = else if get_type_name type_path = "" then match get_module_path type_path with | [] -> "\\" - | _ -> "\\" ^ (String.concat "\\" (get_real_path (fst type_path))) ^ "\\" + | module_path -> "\\" ^ (String.concat "\\" (get_real_path module_path)) ^ "\\" else begin let orig_type_path = type_path in let type_path = match type_path with (pack, name) -> (pack, get_real_name name) in @@ -1380,16 +1380,17 @@ class code_writer (ctx:php_generator_context) hx_type_path php_name = Extracts type path from Type.t value and execute self#use on it @return Unique alias for specified type. *) - method use_t (t_inst:Type.t) = + method use_t ?(for_doc=false) (t_inst:Type.t) = match follow t_inst with | TEnum (tenum, _) -> self#use tenum.e_path - | TInst (tcls, _) -> + | TInst (tcls, params) -> (match tcls.cl_kind with | KTypeParameter _ -> "mixed" | _ -> - (match tcls.cl_path with - | ([], "String") -> "string" - | _ -> self#use ~prefix:(not tcls.cl_extern) tcls.cl_path + (match tcls.cl_path, params with + | ([], "String"), _ -> "string" + | ([], "Array"), [param] when for_doc -> (self#use_t param) ^ "[]|" ^ (self#use tcls.cl_path) + | _ -> self#use ~prefix:(not (has_class_flag tcls CExtern)) tcls.cl_path ) ) | TFun _ -> self#use ~prefix:false ([], "Closure") @@ -1409,7 +1410,12 @@ class code_writer (ctx:php_generator_context) hx_type_path php_name = | ([],"Bool") -> "bool" | ([],"Void") -> "void" | ([],"Enum") -> "Enum" - | ([], "Class") -> "Class" + | ([],"Class") -> "Class" + | (["php"],"NativeArray") when for_doc -> + (match Type.follow t_inst with + | TAbstract ({ a_path = ["php"],"NativeIndexedArray" }, [param]) -> (self#use_t param) ^ "[]" + | _ -> "array" + ) | _ when Meta.has Meta.CoreType abstr.a_meta -> "mixed" | _ -> self#use_t abstr.a_this (** @@ -1475,6 +1481,30 @@ class code_writer (ctx:php_generator_context) hx_type_path php_name = match self#parent_expr with | Some { eexpr = TCall _ } -> true | _ -> false + (** + Indicates if current expression is passed to `php.Ref` + *) + method current_expr_is_for_ref = + match expr_hierarchy with + | [] -> false + | current :: _ -> + match self#parent_expr with + | Some { eexpr = TCall (target, params) } when current != (reveal_expr target) -> + (match follow target.etype with + | TFun (args,_) -> + let rec check args params = + match args, params with + | (_, _, t) :: _, param :: _ when current == (reveal_expr param) -> + is_ref t + | _, [] | [], _ -> + false + | _ :: args, _ :: params -> + check args params + in + check args params + | _ -> false + ) + | _ -> false (** Check if currently generated expression is located in a left part of assignment. *) @@ -1593,12 +1623,7 @@ class code_writer (ctx:php_generator_context) hx_type_path php_name = | None -> self#write_expr value_expr; | Some key_str -> - let key_str = - Str.global_replace (Str.regexp "\\$") - "\\$" - (String.escaped key_str) - in - self#write ("\"" ^ key_str ^ "\" => "); + self#write ((quote_string key_str) ^ " => "); self#write_expr value_expr ); if separate_line then self#write ",\n" @@ -1619,6 +1644,8 @@ class code_writer (ctx:php_generator_context) hx_type_path php_name = | TBinop (operation, expr1, expr2) when needs_dereferencing (is_assignment_binop operation) expr1 -> self#write_expr { expr with eexpr = TBinop (operation, self#dereference expr1, expr2) } | TBinop (operation, expr1, expr2) -> self#write_expr_binop operation expr1 expr2 + | TField ({ eexpr = TArrayDecl exprs }, faccess) when is_array_arr faccess && not self#current_expr_is_for_ref -> + self#write_native_array_decl exprs | TField (fexpr, access) when is_php_global expr -> self#write_expr_php_global expr | TField (fexpr, access) when is_php_class_const expr -> self#write_expr_php_class_const expr | TField (fexpr, access) when needs_dereferencing (self#is_in_write_context) expr -> self#write_expr (self#dereference expr) @@ -1700,16 +1727,27 @@ class code_writer (ctx:php_generator_context) hx_type_path php_name = | _ -> decl() ) + | _ -> + self#write ((self#use array_type_path) ^ "::wrap("); + self#write_native_array_decl exprs; + self#write ")" + (** + Writes native array declaration to output buffer + *) + method write_native_array_decl exprs = + match exprs with + | [] -> + self#write "[]"; | [expr] -> - self#write ((self#use array_type_path) ^ "::wrap(["); + self#write "["; self#write_expr expr; - self#write "])" + self#write "]" | _ -> - self#write ((self#use array_type_path) ^ "::wrap([\n"); + self#write "[\n"; self#indent_more; List.iter (fun expr -> self#write_array_item ~separate_line:true expr) exprs; self#indent_less; - self#write_with_indentation "])" + self#write_with_indentation "]" (** Write associative array declaration *) @@ -2062,7 +2100,9 @@ class code_writer (ctx:php_generator_context) hx_type_path php_name = match (reveal_expr expr).eexpr with | TConst TNull -> self#write "'null'" | TBinop _ | TUnop _ -> self#write_expr (parenthesis expr) - | TParenthesis { eexpr = (TBinop _ | TUnop _) } -> self#write_expr expr + | TParenthesis { eexpr = (TBinop _ | TUnop _) } + | TCall ({ eexpr = TField (_, FStatic ({ cl_path = ([],"Std") }, { cf_name = "string" })) }, [_]) -> + self#write_expr expr | _ -> self#write "("; self#write_expr expr; @@ -2161,6 +2201,7 @@ class code_writer (ctx:php_generator_context) hx_type_path php_name = | Postfix -> self#write_expr expr; self#write (Ast.s_unop operation) + method private write_expr_for_field_access expr access_str field_str = let access_str = ref access_str in (match (reveal_expr expr).eexpr with @@ -2264,7 +2305,7 @@ class code_writer (ctx:php_generator_context) hx_type_path php_name = | FInstance (_, _, ({ cf_kind = Method _ } as field)) | FClosure (_, ({ cf_kind = Method _ } as field)) -> self#write ((self#use hxstring_type_path) ^ "::" ^ (field_name field) ^ "("); - write_args self#write self#write_expr (expr :: args); + write_args self#write self#write_expr (fix_call_args field.cf_type (expr :: args)); self#write ")" | _ -> let msg = @@ -2281,7 +2322,7 @@ class code_writer (ctx:php_generator_context) hx_type_path php_name = | _ -> self#write_expr expr and operator = match (reveal_expr expr).eexpr with - | TTypeExpr (TClassDecl { cl_extern = true; cl_path = (_,"") }) -> "" + | TTypeExpr (TClassDecl ({ cl_path = (_,"") } as c)) when (has_class_flag c CExtern) -> "" | TTypeExpr _ -> "::" | _ -> "->" in @@ -2342,11 +2383,59 @@ class code_writer (ctx:php_generator_context) hx_type_path php_name = *) method write_expr_object_declaration fields = match fields with - | [] -> self#write ("new " ^ (self#use hxanon_type_path) ^ "()") + | [] -> self#write ("new " ^ (self#use hxanon_type_path) ^ "()") | _ -> - self#write ("new " ^ (self#use hxanon_type_path) ^ "("); - self#write_assoc_array_decl fields; - self#write ")" + let inits,args_exprs,args_names = + List.fold_left (fun (inits,args_exprs,args_names) ((name,p,quotes), e) -> + let field,arg_name = + if quotes = NoQuotes then name,name + else "{" ^ (quote_string name) ^ "}", "_hx_" ^ (string_of_int (List.length args_exprs)) + in + (field,mk (TIdent ("$"^arg_name)) e.etype p) :: inits, e :: args_exprs, arg_name :: args_names + ) ([],[],[]) fields + in + let anon_name, declare_class = + let key = List.map (fun ((name,_,_),_) -> name) fields in + try + Hashtbl.find ctx.pgc_anons key, false + with Not_found -> + let name = "_HxAnon_" ^ self#get_name ^ (string_of_int (Hashtbl.length ctx.pgc_anons)) in + Hashtbl.add ctx.pgc_anons key name; + name, true + in + self#write ("new " ^ anon_name ^ "("); + write_args self#write self#write_expr (List.rev args_exprs); + self#write ")"; + if declare_class then begin + (* save writer's state *) + let original_buffer = buffer + and original_indentation = self#get_indentation in + let sm_pointer_before_body = get_sourcemap_pointer sourcemap in + (* generate a class for this anon *) + buffer <- ctx.pgc_bottom_buffer; + self#set_indentation 0; + self#write ("\nclass " ^ anon_name ^ " extends " ^ (self#use hxanon_type_path) ^ " {\n"); + self#indent_more; + self#write_with_indentation "function __construct("; + write_args self#write (fun name -> self#write ("$" ^ name)) (List.rev args_names); + self#write ") {\n"; + self#indent_more; + List.iter (fun (field,e) -> + self#write_with_indentation "$this->"; + self#write field; + self#write " = "; + self#write_expr e; + self#write ";\n"; + ) (List.rev inits); + self#indent_less; + self#write_line "}"; + self#indent_less; + self#write_with_indentation "}\n"; + (* restore writer's state *) + buffer <- original_buffer; + self#set_indentation original_indentation; + set_sourcemap_pointer sourcemap sm_pointer_before_body + end (** Writes specified type to output buffer depending on type of expression. *) @@ -2613,7 +2702,7 @@ class code_writer (ctx:php_generator_context) hx_type_path php_name = if not !no_call then begin self#write "("; - write_args self#write self#write_expr args; + write_args self#write self#write_expr (fix_call_args target_expr.etype args); self#write ")" end (** @@ -2676,8 +2765,13 @@ class code_writer (ctx:php_generator_context) hx_type_path php_name = Writes TNew to output buffer *) method write_expr_new inst_class args = - let needs_php_prefix = not inst_class.cl_extern in + let needs_php_prefix = not (has_class_flag inst_class CExtern) in self#write ("new " ^ (self#use ~prefix:needs_php_prefix inst_class.cl_path) ^ "("); + let args = + match inst_class.cl_constructor with + | Some field -> fix_call_args field.cf_type args + | None -> args + in write_args self#write self#write_expr args; self#write ")" (** @@ -2827,7 +2921,9 @@ class code_writer (ctx:php_generator_context) hx_type_path php_name = Writes argument for function declarations or calls *) method write_arg with_optionals (arg_name, optional, (arg_type:Type.t)) = - self#write ("$" ^ arg_name ^ (if with_optionals && optional then " = null" else "")) + let rest = if is_rest_type arg_type then "..." else "" + and opt = if with_optionals && optional then " = null" else "" in + self#write (rest ^ "$" ^ arg_name ^ opt); (** Writes argument with optional value for function declarations *) @@ -2835,6 +2931,7 @@ class code_writer (ctx:php_generator_context) hx_type_path php_name = match arg with | ({ v_name = arg_name; v_type = arg_type }, default_value) -> vars#declared (vname arg_name); + if is_rest_type arg_type then self#write "..."; if is_ref arg_type then self#write "&"; self#write ("$" ^ (vname arg_name)); match default_value with @@ -2955,27 +3052,31 @@ class virtual type_builder ctx (wrapper:type_wrapper) = if wrapper#needs_initialization then self#write_hx_init; writer#indent 0; writer#write_line "}"; (** closing bracket for a class *) - writer#write_empty_lines; - let boot_class = writer#use boot_type_path in - (* Boot initialization *) - if boot_type_path = self#get_type_path then begin - writer#write_statement ("require_once __DIR__.'/" ^ polyfills_file ^ "'"); - writer#write_statement (boot_class ^ "::__hx__init()") - end; - let haxe_class = match wrapper#get_type_path with (path, name) -> String.concat "." (path @ [name]) in - writer#write_statement (boot_class ^ "::registerClass(" ^ (self#get_name) ^ "::class, '" ^ haxe_class ^ "')"); - self#write_rtti_meta; - self#write_pre_hx_init; - (* Current class initialization *) - if wrapper#needs_initialization && boot_type_path <> self#get_type_path then - writer#write_statement (self#get_name ^ "::__hx__init()"); let body = writer#get_contents in + writer#clear_contents; + let footer = + writer#write "\n"; + let boot_class = writer#use boot_type_path in + (* Boot initialization *) + if boot_type_path = self#get_type_path then begin + writer#write_statement ("require_once __DIR__.'/" ^ polyfills_file ^ "'"); + writer#write_statement (boot_class ^ "::__hx__init()") + end; + let haxe_class = match wrapper#get_type_path with (path, name) -> String.concat "." (path @ [name]) in + writer#write_statement (boot_class ^ "::registerClass(" ^ (self#get_name) ^ "::class, '" ^ haxe_class ^ "')"); + self#write_rtti_meta; + self#write_pre_hx_init; + (* Current class initialization *) + if wrapper#needs_initialization && boot_type_path <> self#get_type_path then + writer#write_statement (self#get_name ^ "::__hx__init()"); + writer#get_contents + in Option.may (fun smap -> smap#rewind) self#get_sourcemap_generator; writer#clear_contents; self#write_header; writer#write "\n"; let header = writer#get_contents in - contents <- header ^ body; + contents <- header ^ body ^ (Buffer.contents ctx.pgc_bottom_buffer) ^ footer end; contents (** @@ -3050,11 +3151,11 @@ class virtual type_builder ctx (wrapper:type_wrapper) = let write_arg arg = match arg with | (arg_name, is_optional, arg_type) -> - writer#write_line (" * @param " ^ (writer#use_t arg_type) ^ " $" ^ arg_name) + writer#write_line (" * @param " ^ (writer#use_t ~for_doc:true arg_type) ^ " $" ^ arg_name) in List.iter write_arg args; if List.length args > 0 then writer#write_line " * "; - writer#write_line (" * @return " ^ (writer#use_t return_type)); + writer#write_line (" * @return " ^ (writer#use_t ~for_doc:true return_type)); writer#write_line " */" (** Writes rtti meta to output buffer @@ -3099,10 +3200,10 @@ class virtual type_builder ctx (wrapper:type_wrapper) = (** Writes method to output buffer *) - method private write_method name func is_static = + method private write_method name func is_static is_abstract = match name with | "__construct" -> self#write_constructor_declaration func - | _ -> self#write_method_declaration name func is_static + | _ -> self#write_method_declaration name func is_static is_abstract (** Writes constructor declaration (except visibility and `static` keywords) to output buffer *) @@ -3120,7 +3221,8 @@ class virtual type_builder ctx (wrapper:type_wrapper) = (** Writes method declaration (except visibility keywords) to output buffer *) - method private write_method_declaration name func is_static = + method private write_method_declaration name func is_static is_abstract = + if is_abstract then writer#write "abstract "; if is_static then writer#write "static "; let by_ref = if is_ref func.tf_type then "&" else "" in writer#write ("function " ^ by_ref ^ name ^ " ("); @@ -3351,7 +3453,7 @@ class class_builder ctx (cls:tclass) = Indicates if type should be declared as `final` *) method is_final = - if not cls.cl_final then + if not (has_class_flag cls CFinal) then false else begin let hacked = ref false in @@ -3438,7 +3540,8 @@ class class_builder ctx (cls:tclass) = method private write_declaration = self#write_doc (DocClass (gen_doc_text_opt cls.cl_doc)); if self#is_final then writer#write "final "; - writer#write (if cls.cl_interface then "interface " else "class "); + if has_class_flag cls CAbstract then writer#write "abstract "; + writer#write (if (has_class_flag cls CInterface) then "interface " else "class "); writer#write self#get_name; ( match cls.cl_super with @@ -3448,7 +3551,7 @@ class class_builder ctx (cls:tclass) = writer#write (" extends " ^ super_name) ); if List.length cls.cl_implements > 0 then begin - writer#write (if cls.cl_interface then " extends " else " implements "); + writer#write (if (has_class_flag cls CInterface) then " extends " else " implements "); let use_interface iface = match iface with | (i, params) -> writer#use_t (TInst (i, params)) @@ -3530,7 +3633,7 @@ class class_builder ctx (cls:tclass) = self#write_php_prefix (); at_least_one_field_written := true end; - if not cls.cl_interface then begin + if not (has_class_flag cls CInterface) then begin (* Inlined statc vars (constants) *) PMap.iter (write_if_constant) cls.cl_statics; if !at_least_one_field_written then writer#write_empty_lines; @@ -3555,7 +3658,7 @@ class class_builder ctx (cls:tclass) = self#write_toString_if_required method private write_toString_if_required = if PMap.exists "toString" cls.cl_fields then - if (not cls.cl_interface) && (not (PMap.exists "__toString" cls.cl_statics)) && (not (PMap.exists "__toString" cls.cl_fields)) then + if (not (has_class_flag cls CInterface)) && (not (PMap.exists "__toString" cls.cl_statics)) && (not (PMap.exists "__toString" cls.cl_fields)) then begin writer#write_empty_lines; writer#indent 1; @@ -3569,7 +3672,7 @@ class class_builder ctx (cls:tclass) = Check if this class requires constructor to be generated even if there is no user-defined one *) method private constructor_is_required = - if cls.cl_interface || List.length self#get_namespace > 0 then + if (has_class_flag cls CInterface) || List.length self#get_namespace > 0 then false else begin let required = ref false in @@ -3669,7 +3772,7 @@ class class_builder ctx (cls:tclass) = *) method private write_var field is_static = writer#indent 1; - self#write_doc (DocVar (writer#use_t field.cf_type, (gen_doc_text_opt field.cf_doc))); + self#write_doc (DocVar (writer#use_t ~for_doc:true field.cf_type, (gen_doc_text_opt field.cf_doc))); writer#write_indentation; if is_static then writer#write "static "; let visibility = get_visibility field.cf_meta in @@ -3712,6 +3815,7 @@ class class_builder ctx (cls:tclass) = self#write_doc (DocMethod (args, return_type, (gen_doc_text_opt field.cf_doc))); writer#write_indentation; if self#is_final_field field then writer#write "final "; + if has_class_field_flag field CfAbstract then writer#write "abstract "; writer#write ((get_visibility field.cf_meta) ^ " "); match field.cf_expr with | None -> @@ -3722,7 +3826,7 @@ class class_builder ctx (cls:tclass) = writer#write " ;\n" | Some { eexpr = TFunction fn } -> let name = if field.cf_name = "new" then "__construct" else (field_name field) in - self#write_method name fn is_static; + self#write_method name fn is_static (has_class_field_flag field CfAbstract); writer#write "\n" | _ -> fail field.cf_pos __LOC__ (** @@ -3843,6 +3947,7 @@ class generator (ctx:php_generator_context) = Generates php file for specified type *) method generate (builder:type_builder) = + reset_context ctx; let namespace = builder#get_namespace and name = builder#get_name in let filename = (create_dir_recursive (build_dir :: namespace)) ^ "/" ^ name ^ ".php" in @@ -3979,7 +4084,9 @@ let generate (com:context) = pgc_skip_line_directives = Common.defined com Define.RealPosition; pgc_prefix = Str.split (Str.regexp "\\.") (Common.defined_value_safe com Define.PhpPrefix); pgc_boot = get_boot com; - pgc_namespaces_types_cache = Hashtbl.create 512 + pgc_namespaces_types_cache = Hashtbl.create 512; + pgc_anons = Hashtbl.create 0; + pgc_bottom_buffer = Buffer.create 0 } in let gen = new generator ctx in diff --git a/src/generators/genpy.ml b/src/generators/genpy.ml index 081723a4..7f58398c 100644 --- a/src/generators/genpy.ml +++ b/src/generators/genpy.ml @@ -16,7 +16,7 @@ along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. *) - +open Extlib_leftovers open Globals open Ast open Type @@ -1058,6 +1058,7 @@ module Printer = struct | Not -> "not " | Neg -> "-"; | NegBits -> "~" + | Spread -> "*" let print_binop = function | OpAdd -> "+" @@ -1128,7 +1129,7 @@ module Printer = struct if !had_kw_args then abort "Arguments after KwArgs are not allowed" p; had_kw_args := true; "**" ^ name - | TAbstract({a_path = ["python"],"VarArgs"},_) -> + | TAbstract({a_path = (["python"],"VarArgs" | ["haxe"],"Rest")},_) -> check_err (); had_var_args := true; "*" ^ name @@ -1427,8 +1428,8 @@ module Printer = struct in let name = field_name fa in let is_extern = (match fa with - | FInstance(c,_,_) -> c.cl_extern - | FStatic(c,_) -> c.cl_extern + | FInstance(c,_,_) -> (has_class_flag c CExtern) + | FStatic(c,_) -> (has_class_flag c CExtern) | _ -> false) in let do_default () = @@ -1459,7 +1460,7 @@ module Printer = struct Printf.sprintf "python_Boot.createClosure(%s, python_internal_ArrayImpl.%s)" obj name | FInstance (c,_,cf) when ((is_type "" "str")(TClassDecl c)) -> Printf.sprintf "python_Boot.createClosure(%s, HxString.%s)" obj name - | FStatic (c,cf) when c.cl_extern && c.cl_path = ([],"") -> + | FStatic (c,cf) when (has_class_flag c CExtern) && c.cl_path = ([],"") -> Printf.sprintf "%s" name | FInstance _ | FStatic _ -> do_default () @@ -1636,8 +1637,8 @@ module Printer = struct in let prefix = match e1.eexpr, follow x.etype with (* the should not apply for the instance methods of the abstract itself *) - | TField(_, FStatic({cl_path = ["python"; "_KwArgs"],"KwArgs_Impl_"},f)), _ when i == 0 && Meta.has Meta.Impl f.cf_meta -> "" - | TField(_, FStatic({cl_path = ["python"; "_VarArgs"],"VarArgs_Impl_"},f)), _ when i == 0 && Meta.has Meta.Impl f.cf_meta -> "" + | TField(_, FStatic({cl_path = ["python"; "_KwArgs"],"KwArgs_Impl_"},f)), _ when i == 0 && has_class_field_flag f CfImpl -> "" + | TField(_, FStatic({cl_path = ["python"; "_VarArgs"],"VarArgs_Impl_"},f)), _ when i == 0 && has_class_field_flag f CfImpl -> "" | _, TAbstract({a_path = ["python"],"KwArgs"},_) -> "**" | _, TAbstract({a_path = ["python"],"VarArgs"},_) -> "*" | _, _ -> "" @@ -1717,11 +1718,9 @@ module Generator = struct (* Transformer interface *) let transform_expr e = - (* let e = Codegen.UnificationCallback.run Transformer.check_unification e in *) Transformer.transform e let transform_to_value e = - (* let e = Codegen.UnificationCallback.run Transformer.check_unification e in *) Transformer.transform_to_value e (* Printer interface *) @@ -1750,8 +1749,6 @@ module Generator = struct let methods = DynArray.create () in List.iter (fun cf -> match cf.cf_kind with - | Var({v_read = AccResolve}) -> - () | Var _ when not (is_physical_field cf) -> () | Var({v_read = AccCall}) -> @@ -1958,7 +1955,7 @@ module Generator = struct print ctx " @staticmethod\n def _hx_empty_init(_hx_o):"; let found_fields = ref false in List.iter (fun cf -> match cf.cf_kind with - | Var ({v_read = AccResolve | AccCall}) -> + | Var ({v_read = AccCall}) -> () | Var _ -> found_fields := true; @@ -2028,7 +2025,7 @@ module Generator = struct ctx.class_inits <- f :: ctx.class_inits let gen_class ctx c = - if not c.cl_extern then begin + if not (has_class_flag c CExtern) then begin let is_nativegen = Meta.has Meta.NativeGen c.cl_meta in let mt = (t_infos (TClassDecl c)) in let p = get_path mt in @@ -2061,7 +2058,7 @@ module Generator = struct print ctx "\n _hx_class_name = \"%s\"" p_name end; if has_feature ctx "python._hx_is_interface" then begin - let value = if c.cl_interface then "True" else "False" in + let value = if (has_class_flag c CInterface) then "True" else "False" in print ctx "\n _hx_is_interface = \"%s\"" value end; @@ -2121,7 +2118,7 @@ module Generator = struct let has_inner_static = gen_class_statics ctx c p in - let has_empty_constructor = match ((Meta.has Meta.NativeGen c.cl_meta) || c.cl_interface), c.cl_ordered_fields with + let has_empty_constructor = match ((Meta.has Meta.NativeGen c.cl_meta) || (has_class_flag c CInterface)), c.cl_ordered_fields with | true,_ | _, [] -> false @@ -2132,7 +2129,7 @@ module Generator = struct let use_pass = !use_pass && (not has_inner_static) && (not has_empty_constructor) && match x.cfd_methods with | [] -> c.cl_constructor = None - | _ -> c.cl_interface + | _ -> (has_class_flag c CInterface) in if use_pass then spr ctx "\n pass"; @@ -2349,7 +2346,7 @@ module Generator = struct in List.iter (fun mt -> match mt with - | TClassDecl c when c.cl_extern -> import c.cl_path c.cl_meta + | TClassDecl c when (has_class_flag c CExtern) -> import c.cl_path c.cl_meta | TEnumDecl e when e.e_extern -> import e.e_path e.e_meta | _ -> () ) ctx.com.types diff --git a/src/generators/genshared.ml b/src/generators/genshared.ml index 207e3491..f2dd5b1e 100644 --- a/src/generators/genshared.ml +++ b/src/generators/genshared.ml @@ -10,165 +10,88 @@ type method_type = | MConstructor let is_extern_abstract a = match a.a_impl with - | Some {cl_extern = true} -> true + | Some c -> has_class_flag c CExtern | _ -> match a.a_path with | ([],("Void" | "Float" | "Int" | "Single" | "Bool" | "Null")) -> true | _ -> false -let unify_cf map_type c cf el = - let monos = List.map (fun _ -> mk_mono()) cf.cf_params in - match follow (apply_params cf.cf_params monos (map_type cf.cf_type)) with - | TFun(tl'',_) as tf -> - let rec loop2 acc el tl = match el,tl with - | e :: el,(_,o,t) :: tl -> - begin try - Type.unify e.etype t; - loop2 ((e,o) :: acc) el tl - with _ -> - match t,tl with - | TAbstract({a_path=["haxe";"extern"],"Rest"},[t]),[] -> - begin try - let el = List.map (fun e -> unify t e.etype; e,o) el in - Some ((List.rev acc) @ el,tf,(c,cf,monos)) - with _ -> - None - end - | _ -> - None - end - | [],[] -> - Some ((List.rev acc),tf,(c,cf,monos)) - | _ -> - None - in - loop2 [] el tl'' - | t -> - None - -let unify_cf_with_fallback map_type c cf el = - match unify_cf map_type c cf el with - | Some(_,_,r) -> r - | None -> (c,cf,List.map snd cf.cf_params) - -let find_overload map_type c cf el = - let matches = ref [] in - let rec loop cfl = match cfl with - | cf :: cfl -> - begin match unify_cf map_type c cf el with - | Some r -> matches := r :: !matches; - | None -> () - end; - loop cfl - | [] -> - List.rev !matches - in - loop (cf :: cf.cf_overloads) - -let filter_overloads candidates = - match Overloads.Resolution.reduce_compatible candidates with - | [_,_,(c,cf,tl)] -> Some(c,cf,tl) - | [] -> None - | ((_,_,(c,cf,tl)) :: _) (* as resolved *) -> - (* let st = s_type (print_context()) in - print_endline (Printf.sprintf "Ambiguous overload for %s(%s)" name (String.concat ", " (List.map (fun e -> st e.etype) el))); - List.iter (fun (_,t,(c,cf)) -> - print_endline (Printf.sprintf "\tCandidate: %s.%s(%s)" (s_type_path c.cl_path) cf.cf_name (st t)); - ) resolved; *) - Some(c,cf,tl) - -let find_overload_rec' is_ctor map_type c name el = - let candidates = ref [] in - let has_function t1 (_,t2,_) = - begin match follow t1,t2 with - | TFun(tl1,_),TFun(tl2,_) -> type_iseq (TFun(tl1,t_dynamic)) (TFun(tl2,t_dynamic)) - | _ -> false - end - in - let rec loop map_type c = - begin try - let cf = if is_ctor then - (match c.cl_constructor with Some cf -> cf | None -> raise Not_found) - else - PMap.find name c.cl_fields - in - begin match find_overload map_type c cf el with - | [] -> raise Not_found - | l -> - List.iter (fun ((_,t,_) as ca) -> - if not (List.exists (has_function t) !candidates) then candidates := ca :: !candidates - ) l - end; - if Meta.has Meta.Overload cf.cf_meta || cf.cf_overloads <> [] then raise Not_found - with Not_found -> - if c.cl_interface then - List.iter (fun (c,tl) -> loop (fun t -> apply_params c.cl_params (List.map map_type tl) t) c) c.cl_implements - else match c.cl_super with - | None -> () - | Some(c,tl) -> loop (fun t -> apply_params c.cl_params (List.map map_type tl) t) c - end; - in - loop map_type c; - filter_overloads (List.rev !candidates) - -let find_overload_rec is_ctor map_type c cf el = - if Meta.has Meta.Overload cf.cf_meta || cf.cf_overloads <> [] then - find_overload_rec' is_ctor map_type c cf.cf_name el - else match unify_cf map_type c cf el with - | Some (_,_,(c,cf,tl)) -> Some (c,cf,tl) - | None -> Some(c,cf,List.map snd cf.cf_params) +open OverloadResolution -type path_field_mapping = { +type 'a path_field_mapping = { pfm_path : path; pfm_params : type_params; pfm_fields : (string,tclass_field) PMap.t; + mutable pfm_converted : (string * 'a) list option; + pfm_arity : int; } +let count_fields pm = + PMap.fold (fun _ i -> i + 1) pm 0 + let pfm_of_typedef td = match follow td.t_type with | TAnon an -> { pfm_path = td.t_path; pfm_params = td.t_params; pfm_fields = an.a_fields; + pfm_converted = None; + pfm_arity = count_fields an.a_fields; } | _ -> die "" __LOC__ -exception Typedef_result of path_field_mapping - class ['a] tanon_identification (empty_path : string list * string) = let is_normal_anon an = match !(an.a_status) with - | Closed | Const | Opened -> true + | Closed | Const -> true | _ -> false in object(self) - val td_anons = Hashtbl.create 0 + val pfms = Hashtbl.create 0 + val pfm_by_arity = DynArray.create () val mutable num = 0 - method get_anons = td_anons + method get_pfms = pfms - method unify (tc : Type.t) (pfm : path_field_mapping) = + method add_pfm (path : path) (pfm : 'a path_field_mapping) = + while DynArray.length pfm_by_arity <= pfm.pfm_arity do + DynArray.add pfm_by_arity (DynArray.create ()) + done; + DynArray.add (DynArray.get pfm_by_arity pfm.pfm_arity) pfm; + Hashtbl.replace pfms path pfm + + method unify (tc : Type.t) (pfm : 'a path_field_mapping) = let check () = - let monos = List.map (fun _ -> mk_mono()) pfm.pfm_params in - let map = apply_params pfm.pfm_params monos in - begin match follow tc with - | TInst(c,tl) -> - PMap.iter (fun _ cf -> - let cf' = PMap.find cf.cf_name c.cl_fields in - if not (unify_kind cf'.cf_kind cf.cf_kind) then raise (Unify_error [Unify_custom "kind mismatch"]); - Type.unify (apply_params c.cl_params tl (monomorphs cf'.cf_params cf'.cf_type)) (map (monomorphs cf.cf_params cf.cf_type)) - ) pfm.pfm_fields - | TAnon an1 -> - let fields = ref an1.a_fields in - PMap.iter (fun _ cf -> - let cf' = PMap.find cf.cf_name an1.a_fields in - if not (unify_kind cf'.cf_kind cf.cf_kind) then raise (Unify_error [Unify_custom "kind mismatch"]); - fields := PMap.remove cf.cf_name !fields; - Type.type_eq EqDoNotFollowNull cf'.cf_type (map (monomorphs cf.cf_params cf.cf_type)) - ) pfm.pfm_fields; - if not (PMap.is_empty !fields) then raise (Unify_error [Unify_custom "not enough fields"]) - | _ -> - raise (Unify_error [Unify_custom "bad type"]) - end; + let pair_up fields = + PMap.fold (fun cf acc -> + let cf' = PMap.find cf.cf_name fields in + (cf,cf') :: acc + ) pfm.pfm_fields [] + in + let monos = match follow tc with + | TInst(c,tl) -> + let pairs = pair_up c.cl_fields in + let monos = List.map (fun _ -> mk_mono()) pfm.pfm_params in + let map = apply_params pfm.pfm_params monos in + List.iter (fun (cf,cf') -> + if not (unify_kind cf'.cf_kind cf.cf_kind) then raise (Unify_error [Unify_custom "kind mismatch"]); + Type.unify (apply_params c.cl_params tl (monomorphs cf'.cf_params cf'.cf_type)) (map (monomorphs cf.cf_params cf.cf_type)) + ) pairs; + monos + | TAnon an1 -> + let fields = ref an1.a_fields in + let pairs = pair_up an1.a_fields in + let monos = List.map (fun _ -> mk_mono()) pfm.pfm_params in + let map = apply_params pfm.pfm_params monos in + List.iter (fun (cf,cf') -> + if not (unify_kind cf'.cf_kind cf.cf_kind) then raise (Unify_error [Unify_custom "kind mismatch"]); + fields := PMap.remove cf.cf_name !fields; + Type.type_eq EqDoNotFollowNull cf'.cf_type (map (monomorphs cf.cf_params cf.cf_type)) + ) pairs; + if not (PMap.is_empty !fields) then raise (Unify_error [Unify_custom "not enough fields"]); + monos + | _ -> + raise (Unify_error [Unify_custom "bad type"]) + in (* Check if we applied Void to a return type parameter... (#3463) *) List.iter (fun t -> match follow t with | TMono r -> @@ -182,23 +105,27 @@ object(self) with Not_found -> raise (Unify_error []) - method find_compatible (tc : Type.t) = - try - Hashtbl.iter (fun _ td -> - try - self#unify tc td; - raise (Typedef_result td) - with Unify_error _ -> - () - ) td_anons; - raise Not_found - with Typedef_result td -> - td + method find_compatible (arity : int) (tc : Type.t) = + if arity >= DynArray.length pfm_by_arity then + raise Not_found; + let d = DynArray.get pfm_by_arity arity in + let l = DynArray.length d in + let rec loop i = + if i >= l then + raise Not_found; + let pfm = DynArray.unsafe_get d i in + try + self#unify tc pfm; + pfm + with Unify_error _ -> + loop (i + 1) + in + loop 0 method identify_typedef (td : tdef) = let rec loop t = match t with | TAnon an when is_normal_anon an && not (PMap.is_empty an.a_fields) -> - Hashtbl.replace td_anons td.t_path (pfm_of_typedef td); + self#add_pfm td.t_path (pfm_of_typedef td) | TMono {tm_type = Some t} -> loop t | TLazy f -> @@ -212,7 +139,7 @@ object(self) match t with | TType(td,tl) -> begin try - Some (Hashtbl.find td_anons td.t_path) + Some (Hashtbl.find pfms td.t_path) with Not_found -> self#identify accept_anons (apply_params td.t_params tl td.t_type) end @@ -225,11 +152,12 @@ object(self) | TLazy f -> self#identify accept_anons (lazy_type f) | TAnon an when accept_anons && not (PMap.is_empty an.a_fields) -> - PMap.iter (fun _ cf -> - Gencommon.replace_mono cf.cf_type - ) an.a_fields; + let arity = PMap.fold (fun cf i -> + Gencommon.replace_mono cf.cf_type; + i + 1 + ) an.a_fields 0 in begin try - Some (self#find_compatible t) + Some (self#find_compatible arity t) with Not_found -> let id = num in num <- num + 1; @@ -238,8 +166,10 @@ object(self) pfm_path = path; pfm_params = []; pfm_fields = an.a_fields; + pfm_converted = None; + pfm_arity = count_fields an.a_fields; } in - Hashtbl.replace td_anons path pfm; + self#add_pfm path pfm; Some pfm end; | _ -> @@ -254,6 +184,38 @@ type field_generation_info = { mutable super_call_fields : (tclass * tclass_field) list; } +module Info = struct + type 'a tclass_info = { + mutable typedef_implements : tclass list option; + mutable implicit_ctors : ((path * 'a),(tclass * tclass_field)) PMap.t; + } + + class ['a] info_context = object(self) + val class_infos : 'a tclass_info DynArray.t = DynArray.create () + + method get_class_info (c : tclass) = + let rec loop ml = match ml with + | (Meta.Custom ":jvm.classInfo",[(EConst (Int s),_)],_) :: _ -> + DynArray.get class_infos (int_of_string s) + | _ :: ml -> + loop ml + | [] -> + let index = DynArray.length class_infos in + let infos = { + typedef_implements = None; + implicit_ctors = PMap.empty; + } in + DynArray.add class_infos infos; + c.cl_meta <- (Meta.Custom ":jvm.classInfo",[(EConst (Int (string_of_int index)),null_pos)],null_pos) :: c.cl_meta; + infos + in + loop c.cl_meta + end +end + +open Info + + class ['a] preprocessor (basic : basic_types) (convert : Type.t -> 'a) = let make_native cf = cf.cf_meta <- (Meta.NativeGen,[],null_pos) :: cf.cf_meta @@ -263,17 +225,19 @@ class ['a] preprocessor (basic : basic_types) (convert : Type.t -> 'a) = in let rec get_constructor c = match c.cl_constructor, c.cl_super with - | Some cf, _ -> c,cf + | Some cf, _ -> cf | None, None -> raise Not_found | None, Some (csup,cparams) -> get_constructor csup in - object(self) - val implicit_ctors : (path,((path * 'a),(tclass * tclass_field)) PMap.t) Hashtbl.t = Hashtbl.create 0 +object(self) + val infos = new info_context val field_infos : field_generation_info DynArray.t = DynArray.create() - method get_implicit_ctor (path : path) = - Hashtbl.find implicit_ctors path + method get_infos = infos + + method get_implicit_ctor (c : tclass) = + (infos#get_class_info c).implicit_ctors method get_field_info (ml : metadata) = let rec loop ml = match ml with @@ -288,11 +252,8 @@ class ['a] preprocessor (basic : basic_types) (convert : Type.t -> 'a) = method add_implicit_ctor (c : tclass) (c' : tclass) (cf : tclass_field) = let jsig = convert cf.cf_type in - try - let sm = Hashtbl.find implicit_ctors c.cl_path in - Hashtbl.replace implicit_ctors c.cl_path (PMap.add (c'.cl_path,jsig) (c',cf) sm); - with Not_found -> - Hashtbl.add implicit_ctors c.cl_path (PMap.add (c'.cl_path,jsig) (c',cf) PMap.empty) + let info = infos#get_class_info c in + info.implicit_ctors <- (PMap.add (c'.cl_path,jsig) (c',cf)) info.implicit_ctors; method preprocess_constructor_expr (c : tclass) (cf : tclass_field) (e : texpr) = let used_this = ref false in @@ -304,7 +265,7 @@ class ['a] preprocessor (basic : basic_types) (convert : Type.t -> 'a) = | Some(c,tl) -> c,apply_params c.cl_params tl | _ -> die "" __LOC__ in - match find_overload_rec' true map_type csup "new" el with + match resolve_instance_overload true map_type csup "new" el with | Some(c,cf,_) -> let rec loop csup = if c != csup then begin @@ -364,42 +325,6 @@ class ['a] preprocessor (basic : basic_types) (convert : Type.t -> 'a) = super_call_fields = DynArray.to_list super_call_fields; } - method check_overrides c = match c.cl_overrides with - | [] -> - () - | fields -> - let csup,map_type = match c.cl_super with - | Some(c,tl) -> c,apply_params c.cl_params tl - | None -> die "" __LOC__ - in - let fix_covariant_return cf = - let tl = match follow cf.cf_type with - | TFun(tl,_) -> tl - | _ -> die "" __LOC__ - in - match find_overload_rec' false map_type csup cf.cf_name (List.map (fun (_,_,t) -> Texpr.Builder.make_null t null_pos) tl) with - | Some(_,cf',_) -> - let tr = match follow cf'.cf_type with - | TFun(_,tr) -> tr - | _ -> die "" __LOC__ - in - cf.cf_type <- TFun(tl,tr); - cf.cf_expr <- begin match cf.cf_expr with - | Some ({eexpr = TFunction tf} as e) -> - Some {e with eexpr = TFunction {tf with tf_type = tr}} - | e -> - e - end; - | None -> - () - (* TODO: this should never happen if we get the unification right *) - (* Error.error "Could not find overload" cf.cf_pos *) - in - List.iter (fun cf -> - fix_covariant_return cf; - List.iter fix_covariant_return cf.cf_overloads - ) fields - method preprocess_class (c : tclass) = let has_dynamic_instance_method = ref false in let has_field_init = ref false in @@ -418,13 +343,16 @@ class ['a] preprocessor (basic : basic_types) (convert : Type.t -> 'a) = | MStatic -> () in - self#check_overrides c; List.iter (field MStatic) c.cl_ordered_statics; List.iter (field MInstance) c.cl_ordered_fields; match c.cl_constructor with | None -> begin try - let csup,cf = get_constructor c in + let cf = get_constructor c in + let csup = match c.cl_super with + | Some(c,_) -> c + | _ -> die "" __LOC__ + in List.iter (fun cf -> self#add_implicit_ctor c csup cf) (cf :: cf.cf_overloads) with Not_found -> () @@ -442,7 +370,7 @@ class ['a] preprocessor (basic : basic_types) (convert : Type.t -> 'a) = cf.cf_meta <- (Meta.Custom ":jvm.fieldInfo",[(EConst (Int (string_of_int index)),null_pos)],null_pos) :: cf.cf_meta; if not (Meta.has Meta.HxGen cf.cf_meta) then begin let rec loop next c = - if c.cl_extern then make_native cf + if (has_class_flag c CExtern) then make_native cf else match c.cl_constructor with | Some cf' when Meta.has Meta.HxGen cf'.cf_meta -> make_haxe cf | Some cf' when Meta.has Meta.NativeGen cf'.cf_meta -> make_native cf @@ -461,9 +389,8 @@ class ['a] preprocessor (basic : basic_types) (convert : Type.t -> 'a) = List.iter field (cf :: cf.cf_overloads) end -class ['a] typedef_interfaces (anon_identification : 'a tanon_identification) = object(self) +class ['a] typedef_interfaces (infos : 'a info_context) (anon_identification : 'a tanon_identification) = object(self) - val lut = Hashtbl.create 0 val interfaces = Hashtbl.create 0 val interface_rewrites = Hashtbl.create 0 @@ -477,22 +404,27 @@ class ['a] typedef_interfaces (anon_identification : 'a tanon_identification) = method get_interfaces = interfaces method process_class (c : tclass) = - if not (Hashtbl.mem lut c.cl_path) then - self#do_process_class c + let info = infos#get_class_info c in + match info.typedef_implements with + | Some _ -> + () + | None -> + self#do_process_class c info - method private implements (path_class : path) (path_interface : path) = - try - let l = Hashtbl.find lut path_class in - List.exists (fun c -> c.cl_path = path_interface) l - with Not_found -> + method private implements (c : tclass) (path_interface : path) = + let info = infos#get_class_info c in + match info.typedef_implements with + | None -> false + | Some l -> + List.exists (fun c -> c.cl_path = path_interface) l method private implements_recursively (c : tclass) (path : path) = - self#implements c.cl_path path || match c.cl_super with + self#implements c path || match c.cl_super with | Some (c,_) -> self#implements_recursively c path | None -> false - method private make_interface_class (pfm : path_field_mapping) = + method private make_interface_class (pfm : 'a path_field_mapping) = let path_inner = (fst pfm.pfm_path,snd pfm.pfm_path ^ "$Interface") in try Hashtbl.find interfaces path_inner @@ -506,14 +438,14 @@ class ['a] typedef_interfaces (anon_identification : 'a tanon_identification) = if PMap.is_empty fields then raise (Unify_error [Unify_custom "no fields"]); let path,is_extern = try Hashtbl.find interface_rewrites pfm.pfm_path with Not_found -> path_inner,false in let c = mk_class null_module path null_pos null_pos in - c.cl_interface <- true; + add_class_flag c CInterface; c.cl_fields <- fields; c.cl_ordered_fields <- PMap.fold (fun cf acc -> cf :: acc) fields []; - if is_extern then c.cl_extern <- true; + if is_extern then add_class_flag c CExtern; Hashtbl.replace interfaces pfm.pfm_path c; c - method private do_process_class (c : tclass) = + method private do_process_class (c : tclass) (info : 'a tclass_info) = begin match c.cl_super with | Some(c,_) -> self#process_class c | None -> () @@ -531,6 +463,6 @@ class ['a] typedef_interfaces (anon_identification : 'a tanon_identification) = (ci :: acc) with Unify_error _ -> acc - ) anon_identification#get_anons [] in - Hashtbl.add lut c.cl_path l + ) anon_identification#get_pfms [] in + info.typedef_implements <- Some l end \ No newline at end of file diff --git a/src/generators/genswf.ml b/src/generators/genswf.ml index 9383f13d..3480f106 100644 --- a/src/generators/genswf.ml +++ b/src/generators/genswf.ml @@ -133,7 +133,7 @@ let build_dependencies t = List.iter add_type pl; in (match t with - | TClassDecl c when not c.cl_extern -> + | TClassDecl c when not (has_class_flag c CExtern) -> List.iter add_field c.cl_ordered_fields; List.iter add_field c.cl_ordered_statics; (match c.cl_constructor with @@ -580,7 +580,7 @@ let generate swf_header com = List.iter (fun e -> if e.f9_cid <> None then List.iter (fun t -> let extern = (match t with - | TClassDecl c -> c.cl_extern + | TClassDecl c -> (has_class_flag c CExtern) | TEnumDecl e -> e.e_extern | TAbstractDecl a -> false | TTypeDecl t -> false diff --git a/src/generators/genswf9.ml b/src/generators/genswf9.ml index b3043ea7..299dbb23 100644 --- a/src/generators/genswf9.ml +++ b/src/generators/genswf9.ml @@ -16,7 +16,7 @@ along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. *) - +open Extlib_leftovers open Globals open Ast open Type @@ -86,6 +86,22 @@ type context = { boot : path; swf_protected : bool; need_ctor_skip : bool; + (* + Takes an argument list of `call(arg1, arg2, ...)` and if there is a trailing argument `...rest` then returns + ``` + if(rest.length == 0) call(arg1, arg2) + else if(rest.length == 1) call(arg1, arg2, rest[0]) + else if(rest.length == 2) call(arg1, arg2, rest[0], rest[1]) + <... up to 20 rest args ...> + else throw "Too many rest arguments" + ``` + otherwise returns `None` + *) + handle_spread_args : basic_types -> + texpr list (* arguments *) -> + t (* call result type *) -> + (texpr list -> texpr) (* a function which takes an argument list and should return a call expression *) -> + texpr option; mutable cur_class : tclass; mutable debug : bool; mutable last_line : int; @@ -364,7 +380,7 @@ let property ctx fa t = | "ffloor" | "fceil" | "fround" -> ident (String.sub p 1 (String.length p - 1)), None, false | _ -> ident p, None, false) | _ -> ident p, None, false) - | TInst ({ cl_interface = true } as c,_) -> + | TInst (c,_) when (has_class_flag c CInterface) -> (* lookup the interface in which the field was actually declared *) let rec loop c = try @@ -502,7 +518,7 @@ let rename_block_var ctx v = let define_local ctx ?(init=false) v p = let name = v.v_name in let t = v.v_type in - let l = (if v.v_capture then begin + let l = (if has_var_flag v VCaptured then begin let topt = type_opt ctx t in if List.exists (fun (_,x,_) -> name = x) ctx.block_vars || is_member ctx name then rename_block_var ctx v; let pos = List.length ctx.block_vars + 1 in @@ -762,12 +778,13 @@ let begin_fun ctx args tret el stat p = | None -> if c <> None then dparams := Some [v] | Some l -> dparams := Some (v :: l) in - let args, varargs = (match List.rev args with | (({ v_name = "__arguments__"; v_type = t } as v),_) :: l -> (match follow t with | TInst ({ cl_path = ([],"Array") },_) -> List.rev l, Some (v,true) | _ -> List.rev l, Some(v,false)) + | (v,_) :: l when ExtType.is_rest (Type.follow v.v_type) -> + List.rev l, Some (v,true) | _ -> args, None ) in @@ -935,7 +952,7 @@ let rec gen_access ctx e (forset : 'a) : 'a access = | TEnum _, _ -> VId id | TInst (_,tl), et -> let requires_cast = match fa with - | FInstance({cl_interface=true},_,{cf_kind = Var _}) -> + | FInstance(c,_,{cf_kind = Var _}) when (has_class_flag c CInterface) -> (* we have to cast var access on interfaces *) true | FInstance(_,_,cf) -> @@ -1112,7 +1129,12 @@ let rec gen_expr_content ctx retval e = | TBinop (op,e1,e2) -> gen_binop ctx retval op e1 e2 e.etype e.epos | TCall (f,el) -> - gen_call ctx retval f el e.etype + (match ctx.handle_spread_args ctx.com.basic el e.etype (fun el -> { e with eexpr = TCall(f,el) }) with + | Some e -> + gen_expr ctx retval e + | None -> + gen_call ctx retval f el e.etype + ) | TNew ({ cl_path = [],"Array" },_,[]) -> (* it seems that [] is 4 time faster than new Array() *) write ctx (HArray 0) @@ -1121,17 +1143,22 @@ let rec gen_expr_content ctx retval e = write ctx HThrow; no_value ctx retval | TNew (c,tl,pl) -> - let id = type_id ctx (TInst (c,tl)) in - (match id with - | HMParams _ -> - gen_type ctx id; - List.iter (gen_expr ctx true) pl; - write ctx (HConstruct (List.length pl)) - | _ -> - write ctx (HFindPropStrict id); - List.iter (gen_expr ctx true) pl; - write ctx (HConstructProperty (id,List.length pl)) - ); + (match ctx.handle_spread_args ctx.com.basic pl e.etype (fun pl -> { e with eexpr = TNew(c,tl,pl) }) with + | Some e -> + gen_expr ctx retval e + | None -> + let id = type_id ctx (TInst (c,tl)) in + (match id with + | HMParams _ -> + gen_type ctx id; + List.iter (gen_expr ctx true) pl; + write ctx (HConstruct (List.length pl)) + | _ -> + write ctx (HFindPropStrict id); + List.iter (gen_expr ctx true) pl; + write ctx (HConstructProperty (id,List.length pl)) + ); + ) | TFunction f -> write ctx (HFunction (generate_function ctx f true)) | TIf (e0,e1,e2) -> @@ -1399,8 +1426,27 @@ let rec gen_expr_content ctx retval e = end | TIdent s -> abort ("Unbound variable " ^ s) e.epos +and args_as_array ctx mandatory_args spread_arg = + match mandatory_args with + | [] -> + spread_arg + | _ -> + let p = punion_el (List.map (fun e -> ((),e.epos)) mandatory_args) in + let array = mk (TArrayDecl mandatory_args) (ctx.com.basic.tarray t_dynamic) p in + let concat = mk (TField (array,FDynamic "concat")) t_dynamic spread_arg.epos in + mk (TCall (concat,[spread_arg])) (ctx.com.basic.tarray t_dynamic) (punion p spread_arg.epos) and gen_call ctx retval e el r = + match List.rev el with + (* generate a call with `...rest` as `callee.apply(null, [param1, param2].concat(rest))` *) + | { eexpr = TUnop (Spread, Prefix, rest) } :: el_rev -> + let null = mk (TConst TNull) t_dynamic null_pos + and t_array_dyn = ctx.com.basic.tarray t_dynamic in + let t = TFun (["thisArg",false,t_dynamic; "argArray",false,t_array_dyn],r) in + let apply = mk (TField (e,FDynamic "apply")) t e.epos in + gen_call ctx retval apply [null; args_as_array ctx (List.rev el_rev) rest] r + (* normal call without `...rest` *) + | _ -> match e.eexpr , el with | TIdent "__is__", [e;t] -> gen_expr ctx true e; @@ -1636,6 +1682,8 @@ and gen_unop ctx retval op flag e = | NegBits -> gen_expr ctx true e; write ctx (HOp A3OBitNot); + | Spread -> + die ~p:e.epos "Unhandled spread operator" __LOC__ | Increment | Decrement -> let incr = (op = Increment) in @@ -1927,12 +1975,12 @@ let generate_class_statics ctx c const = ) c.cl_ordered_statics let need_init ctx c = - not ctx.swc && not c.cl_extern && List.exists (fun f -> match f.cf_expr with Some e -> not (is_const e) | _ -> false) c.cl_ordered_statics + not ctx.swc && not (has_class_flag c CExtern) && List.exists (fun f -> match f.cf_expr with Some e -> not (is_const e) | _ -> false) c.cl_ordered_statics let generate_extern_inits ctx = List.iter (fun t -> match t with - | TClassDecl c when c.cl_extern -> + | TClassDecl c when (has_class_flag c CExtern) -> (match c.cl_init with | None -> () | Some e -> gen_expr ctx false e); @@ -1966,7 +2014,7 @@ let generate_inits ctx = let generate_class_init ctx c hc = write ctx HGetGlobalScope; - if c.cl_interface then + if (has_class_flag c CInterface) then write ctx HNull else begin let path = (match c.cl_super with None -> ([],"Object") | Some (sup,_) -> sup.cl_path) in @@ -1983,7 +2031,7 @@ let generate_class_init ctx c hc = write ctx (HInitProp (ident f.cf_name)); | _ -> () ) c.cl_ordered_statics; - if not c.cl_interface then write ctx HPopScope; + if not (has_class_flag c CInterface) then write ctx HPopScope; write ctx (HInitProp (type_path ctx c.cl_path)); if ctx.swc && c.cl_path = ctx.boot then generate_extern_inits ctx; (match c.cl_init with @@ -2068,7 +2116,7 @@ let generate_field_kind ctx f c stat = PMap.exists name c.cl_fields || loop c name in (match f.cf_kind with - | Method MethDynamic when List.memq f c.cl_overrides -> + | Method MethDynamic when has_class_field_flag f CfOverride -> None | Var _ | Method MethDynamic -> Some (HFVar { @@ -2080,7 +2128,7 @@ let generate_field_kind ctx f c stat = let name, kind = method_kind() in let m = generate_method ctx fdata stat f.cf_meta in let is_override = not stat && ( - if kind = MK3Normal then List.memq f c.cl_overrides + if kind = MK3Normal then has_class_field_flag f CfOverride else (loop c name || loop c f.cf_name) ) in Some (HFMethod { @@ -2090,7 +2138,7 @@ let generate_field_kind ctx f c stat = hlm_kind = kind; }) ); - | _ when c.cl_interface && not stat -> + | _ when (has_class_flag c CInterface || has_class_field_flag f CfAbstract) && not stat -> (match follow f.cf_type, f.cf_kind with | TFun (args,tret), Method (MethNormal | MethInline) -> let dparams = ref None in @@ -2147,7 +2195,8 @@ let mark_has_protected c = c.cl_meta <- (has_protected_meta,[],null_pos) :: c.cl let find_first_nonextern_accessor_implementor cl name = let rec loop cl cl_found = match cl.cl_super with - | Some ({ cl_extern = true }, _) | None -> cl_found + | None -> cl_found + | Some (c, _) when (has_class_flag c CExtern) -> cl_found | Some (cl_super, _) -> let has_field = PMap.exists name cl_super.cl_fields in let cl_found = if has_field then cl_super else cl_found in @@ -2160,16 +2209,10 @@ let maybe_gen_instance_accessor ctx cl tl accessor_cf acc alloc_slot kind f_impl | Some (_, _, prop_cf) -> let accessor_cl = find_first_nonextern_accessor_implementor cl accessor_cf.cf_name in if accessor_cl == cl then begin - let was_override = ref false in - cl.cl_overrides <- List.filter (fun f2 -> - if f2 == accessor_cf then - (was_override := true; false) - else - true - ) cl.cl_overrides; - + let was_override = has_class_field_flag accessor_cf CfOverride in + if was_override then remove_class_field_flag accessor_cf CfOverride; let name, mtype = - if cl.cl_interface then begin + if (has_class_flag cl CInterface) then begin let (args,tret) = f_iface prop_cf in let mtype = end_fun ctx args None tret in HMName (reserved prop_cf.cf_name, HNNamespace (make_class_ns cl)), mtype @@ -2186,7 +2229,7 @@ let maybe_gen_instance_accessor ctx cl tl accessor_cf acc alloc_slot kind f_impl hlf_kind = HFMethod { hlm_type = mtype; hlm_final = has_class_field_flag accessor_cf CfFinal; - hlm_override = !was_override; + hlm_override = was_override; hlm_kind = kind; }; hlf_metas = None; @@ -2329,7 +2372,7 @@ let realize_required_accessors ctx cl = let rec has_nonextern_field cl name = if PMap.exists name cl.cl_fields then true else match cl.cl_super with - | Some ({ cl_extern = false } as csup, _) -> has_nonextern_field csup name + | Some (csup, _) when not (has_class_flag csup CExtern) -> has_nonextern_field csup name | _ -> false in @@ -2342,7 +2385,7 @@ let realize_required_accessors ctx cl = if not (is_flash_property cf) then abort (Printf.sprintf "Interface %s requires property %s to be marked with @:flash.property" (s_type_path iface.cl_path) cf.cf_name) cf.cf_pos ) native; - if actual_cl.cl_extern then begin + if (has_class_flag actual_cl CExtern) then begin let mk_field_access () = let ethis = mk (TConst TThis) (TInst (cl,tl)) null_pos in mk (TField (ethis, FInstance (actual_cl, actual_tl, cf))) cf.cf_type null_pos @@ -2407,7 +2450,7 @@ let generate_class ctx c = ctx.cur_class <- c; let cid , cnargs = (match c.cl_constructor with | None -> - if c.cl_interface then + if (has_class_flag c CInterface) then { (empty_method ctx null_pos) with hlmt_function = None }, 0 else generate_construct ctx { @@ -2434,7 +2477,7 @@ let generate_class ctx c = let rec find_meta c = try let f = PMap.find f.cf_name (if stat then c.cl_statics else c.cl_fields) in - if List.memq f c.cl_overrides then raise Not_found; + if has_class_field_flag f CfOverride then raise Not_found; f.cf_meta with Not_found -> match c.cl_super with @@ -2460,7 +2503,7 @@ let generate_class ctx c = | (Meta.Protected,[],_) -> protect() | _ -> loop_meta l in - if c.cl_interface then + if (has_class_flag c CInterface) then HMName (reserved f.cf_name, HNNamespace (make_class_ns c)) else loop_meta (find_meta c) @@ -2477,7 +2520,7 @@ let generate_class ctx c = maybe_gen_instance_setter ctx c f acc alloc_slot else maybe_gen_static_setter ctx c f acc alloc_slot - | Var { v_read = (AccCall | AccNever) as read; v_write = (AccCall | AccNever) as write } when not c.cl_interface && not (Meta.has Meta.IsVar f.cf_meta) -> + | Var { v_read = (AccCall | AccNever) as read; v_write = (AccCall | AccNever) as write } when not (has_class_flag c CInterface) && not (Meta.has Meta.IsVar f.cf_meta) -> (* if the accessor methods were defined in super classes, we still need to generate native getter/setter *) let acc = if read = AccCall then begin @@ -2560,7 +2603,7 @@ let generate_class ctx c = hlf_metas = None; } :: fields end in - let fields = if not c.cl_interface then fields @ realize_required_accessors ctx c else fields in + let fields = if not (has_class_flag c CInterface) then fields @ realize_required_accessors ctx c else fields in let st_field_count = ref 0 in let st_meth_count = ref 0 in let statics = List.rev (List.fold_left (fun acc f -> @@ -2597,7 +2640,7 @@ let generate_class ctx c = if Meta.has has_protected_meta csup.cl_meta then begin has_protected := Some (make_class_ns c); mark_has_protected c (* also mark this class with the meta for further child classes *) - end else if csup.cl_extern then begin + end else if (has_class_flag csup CExtern) then begin let rec loop csup = if List.exists is_cf_protected csup.cl_ordered_fields then begin has_protected := Some (make_class_ns c); @@ -2612,13 +2655,13 @@ let generate_class ctx c = { hlc_index = 0; hlc_name = name; - hlc_super = (if c.cl_interface then None else Some (type_path ctx (match c.cl_super with None -> [],"Object" | Some (c,_) -> c.cl_path))); + hlc_super = (if (has_class_flag c CInterface) then None else Some (type_path ctx (match c.cl_super with None -> [],"Object" | Some (c,_) -> c.cl_path))); hlc_sealed = not (is_dynamic c); - hlc_final = c.cl_final; - hlc_interface = c.cl_interface; + hlc_final = has_class_flag c CFinal; + hlc_interface = (has_class_flag c CInterface); hlc_namespace = (match !has_protected with None -> None | Some p -> Some (HNProtected p)); hlc_implements = Array.of_list (List.map (fun (c,_) -> - if not c.cl_interface then abort "Can't implement class in Flash9" c.cl_pos; + if not (has_class_flag c CInterface) then abort "Can't implement class in Flash9" c.cl_pos; let pack, name = real_path c.cl_path in HMMultiName (Some name,[HNPublic (Some (String.concat "." pack))]) ) c.cl_implements); @@ -2740,7 +2783,7 @@ let rec generate_type ctx t = match t with | TClassDecl c -> if c.cl_path = (["flash";"_Boot"],"RealBoot") then c.cl_path <- ctx.boot; - if c.cl_extern && (c.cl_path <> ([],"Dynamic") || Meta.has Meta.RealPath c.cl_meta) then + if (has_class_flag c CExtern) && (c.cl_path <> ([],"Dynamic") || Meta.has Meta.RealPath c.cl_meta) then None else let debug = do_debug ctx c.cl_meta in @@ -2790,6 +2833,41 @@ let generate com boot_name = let ctx = { com = com; need_ctor_skip = Common.has_feature com "Type.createEmptyInstance"; + handle_spread_args = (fun basic args t_result args_to_expr -> + match List.rev args with + | { eexpr = TUnop (Spread,Prefix,rest) } :: args_rev -> + let t_rest_item = match Type.follow rest.etype with TAbstract (_,[t]) -> t | _ -> die "" __LOC__ in + let t_array_dyn = basic.tarray t_dynamic in + let c_array = match t_array_dyn with TInst (c,_) -> c | _ -> die "" __LOC__ in + let length = + let faccess = + try + let cf = PMap.find "length" c_array.cl_fields in + FInstance (c_array,[t_dynamic],cf) + with Not_found -> + FDynamic "length" + in + mk (TField (rest,faccess)) basic.tint rest.epos + in + let const n = mk (TConst (TInt (Int32.of_int n))) basic.tint rest.epos in + let check n = + mk (TBinop (OpEq, length, const n)) basic.tbool rest.epos + in + let rec nargs n acc = + if n < 0 then acc + else nargs (n - 1) ((mk (TArray (rest, const n)) t_rest_item rest.epos) :: acc) + in + let rec loop n e_else = + let args = (nargs (n - 1) args_rev) in + let e = mk (TIf (check n, args_to_expr args, Some e_else)) t_result rest.epos in + if n = 0 then e + else loop (n - 1) e + in + let msg = mk (TConst (TString "Too many rest arguments")) basic.tstring rest.epos in + Some (loop 20 (mk (TThrow msg) t_dynamic rest.epos)) + | _ -> + None + ); debug = com.Common.debug; cur_class = null_class; boot = ([],boot_name); diff --git a/src/generators/hlinterp.ml b/src/generators/hlinterp.ml index 02b84d40..e395662a 100644 --- a/src/generators/hlinterp.ml +++ b/src/generators/hlinterp.ml @@ -19,6 +19,7 @@ * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER * DEALINGS IN THE SOFTWARE. *) +open Extlib_leftovers open Unix open Hlcode diff --git a/src/generators/jvm/jvmClass.ml b/src/generators/jvm/jvmClass.ml index 17435cea..45e3e013 100644 --- a/src/generators/jvm/jvmClass.ml +++ b/src/generators/jvm/jvmClass.ml @@ -48,7 +48,7 @@ class builder path_this path_super = object(self) interface_offsets <- (pool#add_path path) :: interface_offsets; interfaces <- (path,params) :: interfaces - method set_type_parameters (sl : string list) = + method set_type_parameters (sl : (string * jsignature list) list) = type_parameters <- sl method set_super_parameters (params : jtype_argument list) = @@ -153,8 +153,15 @@ class builder path_this path_super = object(self) let stl = match type_parameters with | [] -> "" | params -> - let stl = String.concat "" (List.map (fun n -> - Printf.sprintf "%s:Ljava/lang/Object;" n + let stl = String.concat "" (List.map (fun (n,jsigs) -> + let jsigs = match jsigs with + | [] -> [object_sig] + | _ -> jsigs + in + let s = String.concat "" (List.map (fun jsig -> + Printf.sprintf ":%s" (generate_signature true jsig) + ) jsigs) in + Printf.sprintf "%s%s" n s ) params) in Printf.sprintf "<%s>" stl in diff --git a/src/generators/jvm/jvmCode.ml b/src/generators/jvm/jvmCode.ml index d8f9fe06..b211c2ea 100644 --- a/src/generators/jvm/jvmCode.ml +++ b/src/generators/jvm/jvmCode.ml @@ -88,11 +88,11 @@ class jvm_stack = object(self) raise EmptyStack in loop [] i stack -end - -let s_vt = generate_method_signature true -let s_vtl l = Printf.sprintf "[%s]" (String.concat ", " (List.map s_vt l)) + method replace jsig = + ignore(self#pop); + self#push jsig +end class builder pool = object(self) val stack = new jvm_stack; @@ -102,38 +102,12 @@ class builder pool = object(self) (* ops *) val ops = DynArray.create(); - val stack_debug = DynArray.create() val mutable fp = 0 val mutable terminated = false method is_terminated = terminated method set_terminated b = terminated <- b - method debug_stack = - let l = DynArray.to_list stack_debug in - let opmax = ref 0 in - let l = List.map (fun (op,_,after,line) -> - let sop = JvmDebug.s_jcode pool op in - if String.length sop > !opmax then opmax := String.length sop; - let safter = s_vtl after in - (line,sop,safter) - ) l in - let s_ops = String.concat "\n\t\t" (List.map (fun (line,sop,safter) -> - Printf.sprintf "%4i %*s %s" line !opmax sop safter - ) l) in - s_ops - - method stack_error opcode expected actual = - let s_ops = self#debug_stack in - jerror - (Printf.sprintf "Stack error\n\tops :\n\t\t%s\n\t line: %i\n\toperation: %s\n\texpected : %s\n\tactual : %s" - s_ops - current_line - (JvmDebug.s_jcode pool opcode) - (s_vtl expected) - (s_vtl actual) - ) - method op opcode length expect return = if last_line <> current_line then begin last_line <- current_line; @@ -141,33 +115,10 @@ class builder pool = object(self) end; DynArray.add ops opcode; fp <- fp + length; - let cur = stack#get_stack in List.iter (fun js -> - let js' = try - stack#pop - with EmptyStack -> - self#stack_error opcode expect cur; - Globals.die "" __LOC__ - in - (* TODO: some unification or something? *) - match js,js' with - | (TObject _ | TTypeParameter _),(TObject _ | TTypeParameter _ | TArray _) -> () (* TODO ??? *) - | TMethod _,TMethod _ -> () - | TMethod _,TObject(path,[]) when path = NativeSignatures.haxe_function_path -> () - | TTypeParameter _,TMethod _ -> () - | TObject _,TMethod _ -> () - | TMethod _,TObject _ -> () - | TArray _,TArray _ -> () - | TBool,TInt -> () - | TInt,TBool -> () - | TDouble,TInt -> () - | TInt,(TChar | TShort | TByte) -> () - | (TObject _ | TTypeParameter _),TUninitialized _ -> () - | _ -> - if js <> js' then self#stack_error opcode expect cur + ignore(stack#pop) ) expect; List.iter stack#push (List.rev return); - DynArray.add stack_debug (opcode,cur,stack#get_stack,current_line); if terminates opcode then terminated <- true method op_maybe_wide op opw i tl tr = match get_numeric_range_unsigned i with diff --git a/src/generators/jvm/jvmConstantPool.ml b/src/generators/jvm/jvmConstantPool.ml index 79a8ddd7..d347f2bd 100644 --- a/src/generators/jvm/jvmConstantPool.ml +++ b/src/generators/jvm/jvmConstantPool.ml @@ -16,7 +16,7 @@ along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. *) - +open Extlib_leftovers open IO open IO.BigEndian open JvmGlobals diff --git a/src/generators/jvm/jvmDebug.ml b/src/generators/jvm/jvmDebug.ml deleted file mode 100644 index 17c5d2e9..00000000 --- a/src/generators/jvm/jvmDebug.ml +++ /dev/null @@ -1,281 +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 JvmGlobals -open JvmData - -(* Printing debug functions *) - -let s_const pool const = - let rec loop depth const = - if depth = 3 then - "..." - else begin - let rec_find i = loop (depth + 1) (pool#get i) in - match const with - | ConstUtf8 s -> Printf.sprintf "Utf8 \"%s\"" s - | ConstInt i32 -> Printf.sprintf "Int %i" (Int32.to_int i32) - | ConstFloat f -> Printf.sprintf "Float %f" f - | ConstLong i64 -> Printf.sprintf "Int %i" (Int64.to_int i64) - | ConstDouble f -> Printf.sprintf "Double %f" f - | ConstClass i -> Printf.sprintf "Class(%s)" (rec_find i) - | ConstString i -> Printf.sprintf "String(%s)" (rec_find i) - | ConstFieldref(i1,i2) -> Printf.sprintf "Fieldref(%s, %s)" (rec_find i1) (rec_find i2) - | ConstMethodref(i1,i2) -> Printf.sprintf "Methodref(%s, %s)" (rec_find i1) (rec_find i2) - | ConstInterfaceMethodref(i1,i2) -> Printf.sprintf "InterfaceMethodref(%s, %s)" (rec_find i1) (rec_find i2) - | ConstNameAndType(i1,i2) -> Printf.sprintf "NameAndType(%s, %s)" (rec_find i1) (rec_find i2) - | ConstMethodHandle(i1,i2) -> Printf.sprintf "MethodHandle(%i, %s)" i1 (rec_find i2) - | ConstMethodType i -> Printf.sprintf "MethodType(%s)" (rec_find i) - | ConstInvokeDynamic(i1,i2) -> Printf.sprintf "InvokeDynamic(%i, %s)" i1 (rec_find i2) - end - in - loop 0 const - -let s_const_nice pool const = - let rec loop depth const = - if depth = 3 then - "..." - else begin - let rec_find i = loop (depth + 1) (pool#get i) in - match const with - | ConstUtf8 s -> Printf.sprintf "%s" s - | ConstInt i32 -> Printf.sprintf "%i" (Int32.to_int i32) - | ConstFloat f -> Printf.sprintf "%f" f - | ConstLong i64 -> Printf.sprintf "%i" (Int64.to_int i64) - | ConstDouble f -> Printf.sprintf "%f" f - | ConstClass i -> Printf.sprintf "%s" (rec_find i) - | ConstString i -> Printf.sprintf "%s" (rec_find i) - | ConstFieldref(i1,i2) -> Printf.sprintf "%s.%s" (rec_find i1) (rec_find i2) - | ConstMethodref(i1,i2) -> Printf.sprintf "%s.%s" (rec_find i1) (rec_find i2) - | ConstInterfaceMethodref(i1,i2) -> Printf.sprintf "%s.%s" (rec_find i1) (rec_find i2) - | ConstNameAndType(i1,i2) -> Printf.sprintf "%s:%s" (rec_find i1) (rec_find i2) - | ConstMethodHandle(i1,i2) -> Printf.sprintf "MethodHandle(%i, %s)" i1 (rec_find i2) - | ConstMethodType i -> Printf.sprintf "MethodType(%s)" (rec_find i) - | ConstInvokeDynamic(i1,i2) -> Printf.sprintf "InvokeDynamic(%i, %s)" i1 (rec_find i2) - end - in - loop 0 const - -let s_jcode pool code = - let wi s i = Printf.sprintf "%s %i" s i in - let sc i = s_const_nice pool (pool#get i) in - match code with - (* double *) - | OpD2f -> "d2f" - | OpD2i -> "d2i" - | OpD2l -> "d2l" - | OpDadd -> "dadd" - | OpDaload -> "daload" - | OpDastore -> "dastore" - | OpDcmpg -> "dcmpg" - | OpDcmpl -> "dcmpl" - | OpDdiv -> "ddiv" - | OpDconst_0 -> "dconst_0" - | OpDconst_1 -> "dconst_1" - | OpDload_0 -> "dload_0" - | OpDload_1 -> "dload_1" - | OpDload_2 -> "dload_2" - | OpDload_3 -> "dload_3" - | OpDload i -> wi "dload" i - | OpDmul -> "dmul" - | OpDneg -> "dneg" - | OpDrem -> "drem" - | OpDreturn -> "dreturn" - | OpDstore_0 -> "dstore_0" - | OpDstore_1 -> "dstore_1" - | OpDstore_2 -> "dstore_2" - | OpDstore_3 -> "dstore_3" - | OpDstore i -> wi "dstore" i - | OpDsub -> "dsub" - (* float *) - | OpF2d -> "f2d" - | OpF2i -> "f2i" - | OpF2l -> "f2l" - | OpFadd -> "fadd" - | OpFaload -> "faload" - | OpFastore -> "fastore" - | OpFcmpg -> "fcmpg" - | OpFcmpl -> "fcmpl" - | OpFdiv -> "fdiv" - | OpFconst_0 -> "fconst_0" - | OpFconst_1 -> "fconst_1" - | OpFconst_2 -> "fconst_2" - | OpFload_0 -> "fload_0" - | OpFload_1 -> "fload_1" - | OpFload_2 -> "fload_2" - | OpFload_3 -> "fload_3" - | OpFload i -> wi "fload" i - | OpFmul -> "fmul" - | OpFneg -> "fneg" - | OpFrem -> "frem" - | OpFreturn -> "freturn" - | OpFstore_0 -> "fstore_0" - | OpFstore_1 -> "fstore_1" - | OpFstore_2 -> "fstore_2" - | OpFstore_3 -> "fstore_3" - | OpFstore i -> wi "fstore" i - | OpFsub -> "fsub" - (* int *) - | OpI2b -> "i2b" - | OpI2c -> "i2c" - | OpI2d -> "i2d" - | OpI2f -> "i2f" - | OpI2l -> "i2l" - | OpI2s -> "i2s" - | OpIadd -> "iadd" - | OpIaload -> "iaload" - | OpIand -> "iand" - | OpIastore -> "iastore" - | OpIconst_m1 -> "iconst_m1" - | OpIconst_0 -> "iconst_0" - | OpIconst_1 -> "iconst_1" - | OpIconst_2 -> "iconst_2" - | OpIconst_3 -> "iconst_3" - | OpIconst_4 -> "iconst_4" - | OpIconst_5 -> "iconst_5" - | OpIdiv -> "idiv" - | OpIload_0 -> "iload_0" - | OpIload_1 -> "iload_1" - | OpIload_2 -> "iload_2" - | OpIload_3 -> "iload_3" - | OpIload i -> wi "iload" i - | OpImul -> "imul" - | OpIneg -> "ineg" - | OpIor -> "ior" - | OpIrem -> "irem" - | OpIreturn -> "ireturn" - | OpIshl -> "ishl" - | OpIshr -> "ishr" - | OpIstore_0 -> "istore_0" - | OpIstore_1 -> "istore_1" - | OpIstore_2 -> "istore_2" - | OpIstore_3 -> "istore_3" - | OpIstore i -> wi "istore" i - | OpIsub -> "isub" - | OpIushr -> "iushr" - | OpIxor -> "ixor" - (* long *) - | OpL2d -> "l2d" - | OpL2f -> "l2f" - | OpL2i -> "l2i" - | OpLadd -> "ladd" - | OpLaload -> "laload" - | OpLand -> "land" - | OpLastore -> "lastore" - | OpLconst_0 -> "lconst_0" - | OpLconst_1 -> "lconst_1" - | OpLcmp -> "lcmp" - | OpLdiv -> "ldiv" - | OpLload_0 -> "lload_0" - | OpLload_1 -> "lload_1" - | OpLload_2 -> "lload_2" - | OpLload_3 -> "lload_3" - | OpLload i -> wi "lload" i - | OpLmul -> "lmul" - | OpLneg -> "lneg" - | OpLor -> "lor" - | OpLrem -> "lrem" - | OpLreturn -> "lreturn" - | OpLshl -> "lshl" - | OpLshr -> "lshr" - | OpLstore_0 -> "lstore_0" - | OpLstore_1 -> "lstore_1" - | OpLstore_2 -> "lstore_2" - | OpLstore_3 -> "lstore_3" - | OpLstore i -> wi "lstore" i - | OpLsub -> "lsub" - | OpLushr -> "lushr" - | OpLxor -> "lxor" - (* short *) - | OpSaload -> "saload" - | OpSastore -> "sastore" - | OpSipush i -> wi "sipush" i - (* array *) - | OpAaload -> "aaload" - | OpAastore -> "aastore" - | OpAnewarray offset -> wi "anewarray" offset - | OpArraylength -> "arraylength" - | OpBaload -> "baload" - | OpBastore -> "bastore" - | OpBipush i -> wi "bipush" i - | OpCaload -> "caload" - | OpCastore -> "castore" - | OpMultianewarray(path,i) -> "multinewarray" (* TODO *) - | OpNewarray(jsig) -> "newarray" (* TODO *) - (* reference *) - | OpAload_0 -> "aload_0" - | OpAload_1 -> "aload_1" - | OpAload_2 -> "aload_2" - | OpAload_3 -> "aload_3" - | OpAload i -> wi "aload" i - | OpAreturn -> "areturn" - | OpAstore_0 -> "astore_0" - | OpAstore_1 -> "astore_1" - | OpAstore_2 -> "astore_2" - | OpAstore_3 -> "astore_3" - | OpAstore i -> wi "astore" i - (* object *) - | OpNew offset -> wi "new" offset - | OpInstanceof offset -> wi "instanceof" offset - | OpCheckcast offset -> wi "checkcast" offset - | OpInvokedynamic arg -> "invokedynamic" - | OpInvokeinterface(arg1,arg2) -> "invokeinterface" - | OpInvokespecial arg1 -> Printf.sprintf "invokespecial %s" (sc arg1) - | OpInvokestatic arg1 -> Printf.sprintf "invokestatic %s" (sc arg1) - | OpInvokevirtual arg1 -> Printf.sprintf "invokevirtual %s" (sc arg1) - | OpGetfield arg1 -> Printf.sprintf "getfield %s" (sc arg1) - | OpGetstatic arg1 -> Printf.sprintf "getstatic %s" (sc arg1) - | OpPutfield arg1 -> Printf.sprintf "putfield %s" (sc arg1) - | OpPutstatic arg1 -> Printf.sprintf "putstatic %s" (sc arg1) - (* branching *) - | OpIf_acmpeq i -> wi "acmpeq" !i - | OpIf_acmpne i -> wi "acmpne" !i - | OpIf_icmp(cmp,i) -> wi "if_icmp" !i (* TODO *) - | OpIf(cmp,i) -> wi "if" !i (* TODO *) - | OpIfnonnull i -> wi "ifnotnull" !i - | OpIfnull i -> wi "ifnull" !i - | OpGoto i -> wi "goto" !i - | OpGoto_w i -> wi "goto_w" !i - | OpJsr i -> wi "jsr" !i - | OpJsr_w i -> wi "jsr_w" !i - (* stack *) - | OpAconst_null -> "aconst_null" - | OpDup -> "dup" - | OpDup_x1 -> "dup_x1" - | OpDup_x2 -> "dup_x2" - | OpDup2 -> "dup2" - | OpDup2_x1 -> "dup2_x1" - | OpDup2_x2 -> "dup2_x2" - | OpLdc i -> wi "ldc" i - | OpLdc_w i -> wi "ldc_w" i - | OpLdc2_w i -> wi "ldc2_w" i - | OpNop -> "nop" - | OpPop -> "pop" - | OpPop2 -> "pop2" - | OpSwap -> "swap" - (* other *) - | OpAthrow -> "athrow" - | OpIinc(i1,i2) -> wi "iinc" i1 (* TODO *) - | OpLookupswitch _ -> "lookupswitch" - | OpMonitorenter -> "monitorenter" - | OpMonitorexit -> "monitorexit" - | OpRet i -> wi "ret" i - | OpReturn -> "return" - | OpTableswitch _ -> "tableswitch" - | OpWide _ -> "wide" \ No newline at end of file diff --git a/src/generators/jvm/jvmFunctions.ml b/src/generators/jvm/jvmFunctions.ml index bfc0751f..a29e8395 100644 --- a/src/generators/jvm/jvmFunctions.ml +++ b/src/generators/jvm/jvmFunctions.ml @@ -3,14 +3,14 @@ open JvmSignature open NativeSignatures type signature_classification = + | CBool | CByte | CChar - | CDouble - | CFloat + | CShort | CInt | CLong - | CShort - | CBool + | CFloat + | CDouble | CObject type method_signature = { @@ -122,15 +122,18 @@ class typed_functions = object(self) end; meth - method make_forward_method + method make_forward_method_jsig (jc : JvmClass.builder) (jm : JvmMethod.builder) - (meth_from : method_signature) - (meth_to : method_signature) + (name : string) + (args_from : jsignature list) + (ret_from : jsignature option) + (args_to : jsignature list) + (ret_to : jsignature option) = let args = List.mapi (fun i jsig -> jm#add_local (Printf.sprintf "arg%i" i) jsig VarArgument - ) meth_from.dargs in + ) args_from in jm#finalize_arguments; jm#load_this; let rec loop loads jsigs = match loads,jsigs with @@ -146,9 +149,9 @@ class typed_functions = object(self) | _,[] -> Globals.die "" __LOC__ in - loop args meth_to.dargs; - jm#invokevirtual jc#get_this_path meth_to.name (method_sig meth_to.dargs meth_to.dret); - begin match meth_from.dret,meth_to.dret with + loop args args_to; + jm#invokevirtual jc#get_this_path name (method_sig args_to ret_to); + begin match ret_from,ret_to with | None,None -> () | Some jsig,Some _ -> @@ -160,6 +163,14 @@ class typed_functions = object(self) end; jm#return; + method make_forward_method + (jc : JvmClass.builder) + (jm : JvmMethod.builder) + (meth_from : method_signature) + (meth_to : method_signature) + = + self#make_forward_method_jsig jc jm meth_to.name meth_from.dargs meth_from.dret meth_to.dargs meth_to.dret + method generate_invoke_dynamic (jc : JvmClass.builder) = let array_sig = TArray(object_sig,None) in let jm = jc#spawn_method "invokeDynamic" (method_sig [array_sig] (Some object_sig)) [MPublic] in @@ -214,7 +225,7 @@ class typed_functions = object(self) let jc = new JvmClass.builder (["haxe";"jvm"],"VarArgs") haxe_function_path in jc#add_access_flag 1; (* public *) let jm_ctor = jc#spawn_method "" (method_sig [haxe_function_sig] None) [MPublic] in - jm_ctor#add_argument_and_field "func" haxe_function_sig; + jm_ctor#add_argument_and_field "func" haxe_function_sig [FdPublic;FdFinal]; jm_ctor#finalize_arguments; jm_ctor#load_this; jm_ctor#call_super_ctor ConstructInit (method_sig [] None); @@ -307,7 +318,14 @@ module JavaFunctionalInterfaces = struct jpath = juf,"BiConsumer"; jname = "accept"; jparams = ["T";"U"] - } + }; + { + jargs = [tp "T"]; + jret = Some (tp "R"); + jpath = juf,"Function"; + jname = "apply"; + jparams = ["T";"R"] + }; ] let unify jfi args ret = @@ -351,6 +369,7 @@ module JavaFunctionalInterfaces = struct end open JavaFunctionalInterfaces +open JvmGlobals class typed_function (functions : typed_functions) @@ -362,11 +381,6 @@ class typed_function = object(self) val jc_closure = - let patch_name name = match name with - | "" -> "new" - | "" -> "__init__" - | name -> name - in let name = match kind with | FuncLocal -> Printf.sprintf "Closure_%s_%i" (patch_name host_method#get_name) host_method#get_next_closure_id @@ -385,7 +399,7 @@ class typed_function let context_sigs = List.map snd context in let jm_ctor = jc_closure#spawn_method "" (method_sig context_sigs None) (if public then [MPublic] else []) in List.iter (fun (name,jsig) -> - jm_ctor#add_argument_and_field name jsig; + jm_ctor#add_argument_and_field name jsig [FdPublic;FdFinal]; ) context; jm_ctor#load_this; jm_ctor#call_super_ctor ConstructInit (method_sig [] None); diff --git a/src/generators/jvm/jvmGlobals.ml b/src/generators/jvm/jvmGlobals.ml index 5f5a5d47..788f6388 100644 --- a/src/generators/jvm/jvmGlobals.ml +++ b/src/generators/jvm/jvmGlobals.ml @@ -163,4 +163,9 @@ let write_string ch s = IO.nwrite_string ch s let write_array16 ch f a = write_ui16 ch (Array.length a); - Array.iter (f ch) a \ No newline at end of file + Array.iter (f ch) a + +let patch_name name = match name with + | "" -> "new" + | "" -> "__init__" + | name -> name \ No newline at end of file diff --git a/src/generators/jvm/jvmMethod.ml b/src/generators/jvm/jvmMethod.ml index 3dbf90a1..537692a8 100644 --- a/src/generators/jvm/jvmMethod.ml +++ b/src/generators/jvm/jvmMethod.ml @@ -16,7 +16,7 @@ along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. *) - +open Extlib_leftovers open Globals open JvmGlobals open JvmData @@ -143,6 +143,7 @@ class builder jc name jsig = object(self) val mutable argument_locals = [] val mutable thrown_exceptions = Hashtbl.create 0 val mutable closure_count = 0 + val mutable regex_count = 0 (* per-frame *) val mutable locals = [] @@ -195,6 +196,11 @@ class builder jc name jsig = object(self) closure_count <- closure_count + 1; id + method get_next_regex_id = + let id = regex_count in + regex_count <- regex_count + 1; + id + (** Adds the current state of locals and stack as a stack frame. This has to be called on every branch target. **) method add_stack_frame = let locals = self#get_locals_for_stack_frame locals in @@ -316,15 +322,13 @@ class builder jc name jsig = object(self) (** Adds a field named [name] with signature [jsig_field] to the enclosing class, and adds an argument with the same name to this method. The argument value is loaded and stored into the field immediately. **) - method add_argument_and_field (name : string) (jsig_field : jsignature) = + method add_argument_and_field (name : string) (jsig_field : jsignature) (flags : FieldAccessFlags.t list) = assert (not (self#has_method_flag MStatic)); - let jf = new builder jc name jsig_field in - jf#add_access_flag 1; - jc#add_field jf#export_field; + ignore(jc#spawn_field name jsig_field flags); let _,load,_ = self#add_local name jsig_field VarArgument in self#load_this; load(); - self#putfield jc#get_this_path name jsig_field; + self#putfield jc#get_this_path name jsig_field (** Constructs a [path] object using the specified construction_kind [kind]. @@ -343,7 +347,7 @@ class builder jc name jsig = object(self) code#dup; code#aconst_null haxe_empty_constructor_sig; self#invokespecial path "" (method_sig [haxe_empty_constructor_sig] None); - if not no_value then self#set_top_initialized (object_path_sig path); + if not no_value then self#replace_top (object_path_sig path); if not no_value then code#dup; let jsigs = f () in self#invokevirtual path "new" (method_sig jsigs None); @@ -351,7 +355,7 @@ class builder jc name jsig = object(self) if not no_value then code#dup; let jsigs = f () in self#invokespecial path "" (method_sig jsigs None); - if not no_value then self#set_top_initialized (object_path_sig path) + if not no_value then self#replace_top (object_path_sig path) (** Loads the default value corresponding to a given signature. **) method load_default_value = function @@ -486,8 +490,7 @@ class builder jc name jsig = object(self) in let rec unboxed_to_int () = match code#get_stack#top with | TBool | TByte | TShort | TChar | TInt -> - ignore(code#get_stack#pop); - code#get_stack#push TInt; + self#replace_top TInt; | TLong -> code#l2i; | TFloat -> @@ -556,7 +559,7 @@ class builder jc name jsig = object(self) self#expect_reference_type end else if is_number_sig name jsig then number_to name - else if jsig = object_sig then + else if is_dynamic_at_runtime jsig then dynamic_to name else code#checkcast (["java";"lang"],name) @@ -607,22 +610,20 @@ class builder jc name jsig = object(self) code#l2i; code#i2c; | TBool,TInt -> - ignore(code#get_stack#pop); - code#get_stack#push TBool; + self#replace_top TBool; | TObject(path1,_),TObject(path2,_) when path1 = path2 -> () | TObject((["java";"lang"],"String"),_),_ when allow_to_string -> self#expect_reference_type; self#invokestatic (["haxe";"jvm"],"Jvm") "toString" (method_sig [object_sig] (Some string_sig)) - | TObject(path1,_),TObject(path2,_) -> - if path1 = object_path then begin + | TObject(path1,_),t2 -> + if is_unboxed t2 then + self#expect_reference_type + else if path1 = object_path then begin (* We should never need a checkcast to Object, but we should adjust the stack so stack maps are wide enough *) - ignore(code#get_stack#pop); - code#get_stack#push object_sig + self#replace_top object_sig end else - code#checkcast path1; - | TObject(path,_),TTypeParameter _ -> - code#checkcast path + code#checkcast path1 | TMethod _,TMethod _ -> () | TMethod _,_ -> @@ -998,9 +999,8 @@ class builder jc name jsig = object(self) in locals <- loop [] locals - method set_top_initialized jsig = - ignore(code#get_stack#pop); - code#get_stack#push jsig + method replace_top jsig = + code#get_stack#replace jsig (** This function has to be called once all arguments are declared. *) method finalize_arguments = diff --git a/src/generators/jvm/jvmSignature.ml b/src/generators/jvm/jvmSignature.ml index 8edfbd54..7681f5fa 100644 --- a/src/generators/jvm/jvmSignature.ml +++ b/src/generators/jvm/jvmSignature.ml @@ -81,6 +81,7 @@ module NativeSignatures = struct let java_class_sig = TObject(java_class_path,[TType(WNone,object_sig)]) let haxe_jvm_path = ["haxe";"jvm"],"Jvm" + let haxe_type_path = ["haxe";"root"],"Type" let haxe_dynamic_object_path = ["haxe";"jvm"],"DynamicObject" let haxe_dynamic_object_sig = TObject(haxe_dynamic_object_path,[]) @@ -118,6 +119,12 @@ module NativeSignatures = struct let haxe_function_path = (["haxe";"jvm"],"Function") let haxe_function_sig = TObject(haxe_function_path,[]) + let haxe_compiled_pattern_path = (["haxe";"jvm"],"CompiledPattern") + let haxe_compiled_pattern_sig = TObject(haxe_compiled_pattern_path,[]) + + let haxe_ereg_path = (["haxe";"root"],"EReg") + let haxe_ereg_sig = TObject(haxe_ereg_path,[]) + let void_path = ["java";"lang"],"Void" let void_sig = TObject(void_path,[]) diff --git a/src/macro/eval/EvalStackTrace.ml b/src/macro/eval/EvalStackTrace.ml new file mode 100644 index 00000000..7ef67122 --- /dev/null +++ b/src/macro/eval/EvalStackTrace.ml @@ -0,0 +1,46 @@ +open Globals +open EvalContext +open EvalExceptions +open EvalValue +open EvalEncode +open EvalDecode +open EvalHash +open EvalString + +let make_stack envs = + let l = DynArray.create () in + List.iter (fun (pos,kind) -> + let file_pos s = + let line1,col1,_,_ = Lexer.get_pos_coords pos in + encode_enum_value key_haxe_StackItem 2 [|s;create_unknown pos.pfile;vint line1;vint col1|] None + in + match kind with + | EKLocalFunction i -> + let local_function = encode_enum_value key_haxe_StackItem 4 [|vint i|] None in + DynArray.add l (file_pos local_function); + | EKMethod(st,sf) -> + let local_function = encode_enum_value key_haxe_StackItem 3 [|create_unknown (rev_hash st); create_unknown (rev_hash sf)|] None in + DynArray.add l (file_pos local_function); + | EKEntrypoint -> + () + ) envs; + encode_array (DynArray.to_list l) + +let make_stack_value envs = + make_stack (List.map (fun env -> {pfile = rev_hash env.env_info.pfile;pmin = env.env_leave_pmin; pmax = env.env_leave_pmax},env.env_info.kind) envs) + +let getCallStack = vfun0 (fun () -> + let ctx = get_ctx() in + let envs = call_stack (get_eval ctx) in + let envs = match envs with + | _ :: _ :: envs -> envs (* Skip calls to callStack() and getCallStack() *) + | _ -> envs + in + make_stack_value envs +) + +let getExceptionStack = vfun0 (fun () -> + let ctx = get_ctx() in + let envs = ctx.exception_stack in + make_stack (List.rev envs) +) \ No newline at end of file diff --git a/src/macro/eval/evalContext.ml b/src/macro/eval/evalContext.ml index 956a2232..76a42d7b 100644 --- a/src/macro/eval/evalContext.ml +++ b/src/macro/eval/evalContext.ml @@ -279,6 +279,7 @@ and context = { mutable instance_prototypes : vprototype IntMap.t; mutable static_prototypes : static_prototypes; mutable constructors : value Lazy.t IntMap.t; + file_keys : Common.file_keys; get_object_prototype : 'a . context -> (int * 'a) list -> vprototype * (int * 'a) list; (* eval *) toplevel : value; @@ -289,7 +290,8 @@ and context = { } module GlobalState = struct - let get_ctx_ref : (unit -> context) ref = ref (fun() -> die "" __LOC__) + let get_ctx_ref : (unit -> context) ref = ref (fun() -> die "GlobalState.get_ctx_ref called before initialization" __LOC__) + let initialized = ref false let sid : int ref = ref (-1) @@ -306,7 +308,9 @@ module GlobalState = struct end let get_ctx () = (!GlobalState.get_ctx_ref)() -let select ctx = GlobalState.get_ctx_ref := (fun() -> ctx) +let select ctx = + GlobalState.initialized := true; + GlobalState.get_ctx_ref := (fun() -> ctx) let s_debug_state = function | DbgRunning -> "DbgRunning" @@ -318,8 +322,15 @@ let s_debug_state = function (* Misc *) let get_eval ctx = - let id = Thread.id (Thread.self()) in - if id = 0 then ctx.eval else IntMap.find id ctx.evals + let id = Thread.id (Thread.self()) in + if id = 0 then + ctx.eval + else + try + IntMap.find id ctx.evals + with Not_found -> + die "Cannot run Haxe code in a non-Haxe thread" __LOC__ + let rec kind_name eval kind = let rec loop kind env = match kind with @@ -409,12 +420,12 @@ let no_debug = { debug_pos = null_pos; } -let create_env_info static pfile kind capture_infos num_locals num_captures = +let create_env_info static pfile pfile_key kind capture_infos num_locals num_captures = let info = { static = static; kind = kind; pfile = hash pfile; - pfile_unique = hash (Path.UniqueKey.to_string (Path.UniqueKey.create pfile)); + pfile_unique = hash (Path.UniqueKey.to_string pfile_key); capture_infos = capture_infos; num_locals = num_locals; num_captures = num_captures; @@ -523,3 +534,34 @@ let get_instance_field_index_raise proto name = let get_instance_field_index proto name p = try get_instance_field_index_raise proto name with Not_found -> Error.error (Printf.sprintf "Field index for %s not found on prototype %s" (rev_hash name) (rev_hash proto.ppath)) p + +let is v path = + if path = key_Dynamic then + v <> vnull + else match v with + | VInt32 _ -> path = key_Int || path = key_Float + | VFloat f -> path = key_Float || (path = key_Int && f = (float_of_int (int_of_float f)) && f <= 2147483647. && f >= -2147483648.) + | VTrue | VFalse -> path = key_Bool + | VPrototype {pkind = PClass _} -> path = key_Class + | VPrototype {pkind = PEnum _} -> path = key_Enum + | VEnumValue ve -> path = key_EnumValue || path = ve.epath + | VString _ -> path = key_String + | VArray _ -> path = key_Array + | VVector _ -> path = key_eval_Vector + | VInstance vi -> + let has_interface path' = + try begin match (get_static_prototype_raise (get_ctx()) path').pkind with + | PClass interfaces -> List.mem path interfaces + | _ -> false + end with Not_found -> + false + in + let rec loop proto = + if path = proto.ppath || has_interface proto.ppath then true + else begin match proto.pparent with + | Some proto -> loop proto + | None -> false + end + in + loop vi.iproto + | _ -> false \ No newline at end of file diff --git a/src/macro/eval/evalDebugMisc.ml b/src/macro/eval/evalDebugMisc.ml index 3b350e4d..5785418a 100644 --- a/src/macro/eval/evalDebugMisc.ml +++ b/src/macro/eval/evalDebugMisc.ml @@ -43,7 +43,7 @@ let iter_breakpoints ctx f = ) ctx.debug.breakpoints let add_breakpoint ctx file line column condition = - let hash = hash (Path.UniqueKey.to_string (Path.UniqueKey.create (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 Hashtbl.find ctx.debug.breakpoints hash with Not_found -> @@ -56,7 +56,7 @@ let add_breakpoint ctx file line column condition = breakpoint let delete_breakpoint ctx file line = - let hash = hash (Path.UniqueKey.to_string (Path.UniqueKey.create (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 @@ -285,7 +285,7 @@ let rec expr_to_value ctx env e = end | NegBits -> op_sub (pos e) (vint32 (Int32.minus_one)) (loop e1) - | Increment | Decrement -> + | Increment | Decrement | Spread -> raise Exit end | ECall(e1,el) -> @@ -329,10 +329,10 @@ let rec expr_to_value ctx env e = let v1 = loop e1 in throw v1 (pos e) | EVars vl -> - List.iter (fun ((n,_),_,_,eo) -> - match eo with + List.iter (fun v -> + match v.ev_expr with | Some e -> - env.env_extra_locals <- IntMap.add (hash n) (loop e) env.env_extra_locals + env.env_extra_locals <- IntMap.add (hash (fst v.ev_name)) (loop e) env.env_extra_locals | _ -> () ) vl; @@ -359,7 +359,7 @@ let rec expr_to_value ctx env e = let vc = loop2 ctx.toplevel ["Type";"createInstance"] in safe_call env.env_eval (call_value vc) [v1;encode_array vl] | ETry _ | ESwitch _ | EFunction _ | EFor _ | EDisplay _ - | EDisplayNew _ | ECast(_,Some _) -> + | EDisplayNew _ | ECast(_,Some _) | EIs _ -> raise Exit in loop e diff --git a/src/macro/eval/evalDebugSocket.ml b/src/macro/eval/evalDebugSocket.ml index c097712b..d37401a6 100644 --- a/src/macro/eval/evalDebugSocket.ml +++ b/src/macro/eval/evalDebugSocket.ml @@ -62,12 +62,14 @@ let var_to_json name value vio env = in JObject fields in - let string_repr s = "\"" ^ (StringHelper.s_escape s.sstring) ^ "\"" in + let string_repr s = "\"" ^ (StringHelper.s_escape s) ^ "\"" in let rec level2_value_repr = function | VNull -> "null" | VTrue -> "true" | VFalse -> "false" | VInt32 i -> Int32.to_string i + | VInt64 i -> Signed.Int64.to_string i + | VUInt64 u -> Unsigned.UInt64.to_string u | VFloat f -> string_of_float f | VEnumValue ve -> let name = EvalPrinting.s_enum_ctor_name ve in @@ -76,12 +78,14 @@ let var_to_json name value vio env = | vl -> name ^ "(...)" end | VObject o -> "{...}" - | VString s -> string_repr s + | VString s -> string_repr s.sstring | VArray _ | VVector _ -> "[...]" | VInstance vi -> (rev_hash vi.iproto.ppath) ^ " {...}" | VPrototype proto -> (s_proto_kind proto).sstring | VFunction _ | VFieldClosure _ -> "" | VLazy f -> level2_value_repr (!f()) + | VNativeString s -> string_repr s + | VHandle _ -> "" in let fields_string fields = let l = List.map (fun (name, value) -> Printf.sprintf "%s: %s" (rev_hash name) (level2_value_repr value)) fields in @@ -96,6 +100,8 @@ let var_to_json name value vio env = | VTrue -> jv "Bool" "true" 0 | VFalse -> jv "Bool" "false" 0 | VInt32 i -> jv "Int" (Int32.to_string i) 0 + | VInt64 i -> jv "Int64" (Signed.Int64.to_string i) 0 + | VUInt64 u -> jv "UInt64" (Unsigned.UInt64.to_string u) 0 | VFloat f -> jv "Float" (string_of_float f) 0 | VEnumValue ve -> let type_s = rev_hash ve.epath in @@ -117,7 +123,7 @@ let var_to_json name value vio env = jv "Anonymous" (fields_string fields) (List.length fields) end | VString s -> - jv "String" (string_repr s) 2 + jv "String" (string_repr s.sstring) 2 | VArray va -> jv "Array" (array_elems (EvalArray.to_list va)) va.alength | VVector vv -> jv "Vector" (array_elems (Array.to_list vv)) (Array.length vv) | VInstance vi -> @@ -143,6 +149,9 @@ let var_to_json name value vio env = jv "Anonymous" (s_proto_kind proto).sstring (List.length fields) | VFunction _ | VFieldClosure _ -> jv "Function" "" 0 | VLazy f -> value_string (!f()) + | VNativeString s -> + jv "NativeString" (string_repr s) 0 + | VHandle _ -> jv "Handle" "" 0 in value_string value @@ -262,7 +271,8 @@ let output_scope_vars env scope = let output_inner_vars v env = let rec loop v = match v with - | VNull | VTrue | VFalse | VInt32 _ | VFloat _ | VFunction _ | VFieldClosure _ -> [] + | VNull | VTrue | VFalse | VInt32 _ | VInt64 _ | VUInt64 _ | VFloat _ + | VFunction _ | VFieldClosure _ | VNativeString _ | VHandle _ -> [] | VEnumValue ve -> begin match (get_static_prototype_raise (get_ctx()) ve.epath).pkind with | PEnum names -> @@ -424,7 +434,8 @@ module ValueCompletion = struct | _ -> "field" in let rec loop v = match v with - | VNull | VTrue | VFalse | VInt32 _ | VFloat _ | VFunction _ | VFieldClosure _ -> + | VNull | VTrue | VFalse | VInt32 _ | VInt64 _ | VUInt64 _ | VFloat _ + | VFunction _ | VFieldClosure _ | VNativeString _ | VHandle _-> [] | VObject o -> let fields = object_fields o in @@ -630,7 +641,7 @@ let handler = let file = hctx.jsonrpc#get_string_param "file" in let bps = hctx.jsonrpc#get_array_param "breakpoints" in let bps = List.map (parse_breakpoint hctx) bps in - let hash = hash (Path.UniqueKey.to_string (Path.UniqueKey.create (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 = try let h = Hashtbl.find hctx.ctx.debug.breakpoints hash in diff --git a/src/macro/eval/evalDecode.ml b/src/macro/eval/evalDecode.ml index c2caf823..62f734ce 100644 --- a/src/macro/eval/evalDecode.ml +++ b/src/macro/eval/evalDecode.ml @@ -57,6 +57,14 @@ let decode_vstring v = match v with | VString s -> s | _ -> unexpected_value v "string" +let decode_native_string v = match v with + | VNativeString s -> s + | _ -> unexpected_value v "native string" + +let decode_handle v = match v with + | VHandle h -> h + | _ -> unexpected_value v "handle" + let decode_bytes v = match v with | VInstance {ikind=IBytes s} -> s | _ -> unexpected_value v "string" @@ -109,4 +117,14 @@ let rec decode_ref v : 'a = match v with let num = function | VInt32 i -> Int32.to_float i | VFloat f -> f - | v -> unexpected_value v "number" \ No newline at end of file + | v -> unexpected_value v "number" + +let decode_option decode_value v = + match decode_enum v with + | 0, [v] -> Some (decode_value v) + | 1, [] -> None + | _ -> unexpected_value v "haxe.ds.Option" + +let decode_optional decode_value v = + if v = VNull then None + else Some (decode_value v) \ No newline at end of file diff --git a/src/macro/eval/evalEmitter.ml b/src/macro/eval/evalEmitter.ml index 751facce..b9c172bc 100644 --- a/src/macro/eval/evalEmitter.ml +++ b/src/macro/eval/evalEmitter.ml @@ -441,6 +441,11 @@ let emit_string_cca exec1 exec2 p env = if index < 0 || index >= s.slength then vnull else vint (EvalString.char_at s index) +let emit_string_cca_unsafe exec1 exec2 p env = + let s = decode_vstring (exec1 env) in + let index = decode_int_p (exec2 env) p in + vint (EvalString.char_at s index) + (* Write *) let emit_bytes_length_write exec1 exec2 env = diff --git a/src/macro/eval/evalEncode.ml b/src/macro/eval/evalEncode.ml index 4d630626..a2433649 100644 --- a/src/macro/eval/evalEncode.ml +++ b/src/macro/eval/evalEncode.ml @@ -108,7 +108,30 @@ let vfun5 f = vstatic_function (fun vl -> match vl with | [v0;v1;v2] -> f v0 v1 v2 vnull vnull | [v0;v1;v2;v3] -> f v0 v1 v2 v3 vnull | [v0;v1;v2;v3;v4] -> f v0 v1 v2 v3 v4 - | _ -> invalid_call_arg_number 4 (List.length vl + | _ -> invalid_call_arg_number 5 (List.length vl +)) + +let vfun6 f = vstatic_function (fun vl -> match vl with + | [] -> f vnull vnull vnull vnull vnull vnull + | [v0] -> f v0 vnull vnull vnull vnull vnull + | [v0;v1] -> f v0 v1 vnull vnull vnull vnull + | [v0;v1;v2] -> f v0 v1 v2 vnull vnull vnull + | [v0;v1;v2;v3] -> f v0 v1 v2 v3 vnull vnull + | [v0;v1;v2;v3;v4] -> f v0 v1 v2 v3 v4 vnull + | [v0;v1;v2;v3;v4;v5] -> f v0 v1 v2 v3 v4 v5 + | _ -> invalid_call_arg_number 6 (List.length vl +)) + +let vfun7 f = vstatic_function (fun vl -> match vl with + | [] -> f vnull vnull vnull vnull vnull vnull vnull + | [v0] -> f v0 vnull vnull vnull vnull vnull vnull + | [v0;v1] -> f v0 v1 vnull vnull vnull vnull vnull + | [v0;v1;v2] -> f v0 v1 v2 vnull vnull vnull vnull + | [v0;v1;v2;v3] -> f v0 v1 v2 v3 vnull vnull vnull + | [v0;v1;v2;v3;v4] -> f v0 v1 v2 v3 v4 vnull vnull + | [v0;v1;v2;v3;v4;v5] -> f v0 v1 v2 v3 v4 v5 vnull + | [v0;v1;v2;v3;v4;v5;v6] -> f v0 v1 v2 v3 v4 v5 v6 + | _ -> invalid_call_arg_number 7 (List.length vl )) (* Objects *) @@ -193,6 +216,9 @@ let encode_vector_instance v = let encode_array l = encode_array_instance (EvalArray.create (Array.of_list l)) +let encode_array_a a = + encode_array_instance (EvalArray.create a) + let encode_string s = create_unknown s @@ -290,3 +316,13 @@ let encode_lazy f = v ) in VLazy r + +let encode_option encode_value o = + match o with + | Some v -> encode_enum_value key_haxe_ds_Option 0 [|encode_value v|] None + | None -> encode_enum_value key_haxe_ds_Option 1 [||] None + +let encode_nullable encode_value o = + match o with + | Some v -> encode_value v + | None -> VNull \ No newline at end of file diff --git a/src/macro/eval/evalExceptions.ml b/src/macro/eval/evalExceptions.ml index 6953a3b6..062774b0 100644 --- a/src/macro/eval/evalExceptions.ml +++ b/src/macro/eval/evalExceptions.ml @@ -29,42 +29,13 @@ exception Continue exception Return of value exception Sys_exit of int -let is v path = - if path = key_Dynamic then - v <> vnull - else match v with - | VInt32 _ -> path = key_Int || path = key_Float - | VFloat f -> path = key_Float || (path = key_Int && f = (float_of_int (int_of_float f)) && f <= 2147483647. && f >= -2147483648.) - | VTrue | VFalse -> path = key_Bool - | VPrototype {pkind = PClass _} -> path = key_Class - | VPrototype {pkind = PEnum _} -> path = key_Enum - | VEnumValue ve -> path = key_EnumValue || path = ve.epath - | VString _ -> path = key_String - | VArray _ -> path = key_Array - | VVector _ -> path = key_eval_Vector - | VInstance vi -> - let has_interface path' = - try begin match (get_static_prototype_raise (get_ctx()) path').pkind with - | PClass interfaces -> List.mem path interfaces - | _ -> false - end with Not_found -> - false - in - let rec loop proto = - if path = proto.ppath || has_interface proto.ppath then true - else begin match proto.pparent with - | Some proto -> loop proto - | None -> false - end - in - loop vi.iproto - | _ -> false - let s_value_kind = function | VNull -> "VNull" | VTrue -> "VTrue" | VFalse -> "VFalse" | VInt32 _ -> "VInt32" + | VInt64 _ -> "VInt64" + | VUInt64 _ -> "VUInt64" | VFloat _ -> "VFloat" | VEnumValue _ -> "VEnumValue" | VObject _ -> "VObject" @@ -76,6 +47,8 @@ let s_value_kind = function | VFunction _ -> "VFunction" | VFieldClosure _ -> "VFieldClosure" | VLazy _ -> "VLazy" + | VNativeString _ -> "VNativeString" + | VHandle _ -> "VHandle" let unexpected_value : 'a . value -> string -> 'a = fun v s -> let str = match v with @@ -127,13 +100,19 @@ let handle_stack_overflow eval f = with Stack_overflow -> exc_string "Stack overflow" let catch_exceptions ctx ?(final=(fun() -> ())) f p = - let prev = !GlobalState.get_ctx_ref in + let reset_ctx = + if !GlobalState.initialized then + let prev = !GlobalState.get_ctx_ref in + (fun() -> GlobalState.get_ctx_ref := prev) + else + (fun() -> ()) + in select ctx; let eval = get_eval ctx in let env = eval.env in let r = try let v = handle_stack_overflow eval f in - GlobalState.get_ctx_ref := prev; + reset_ctx(); final(); Some v with @@ -144,7 +123,7 @@ let catch_exceptions ctx ?(final=(fun() -> ())) f p = if is v key_haxe_macro_Error then begin let v1 = field v key_exception_message in let v2 = field v key_pos in - GlobalState.get_ctx_ref := prev; + reset_ctx(); final(); match v1 with | VString s -> @@ -175,7 +154,7 @@ let catch_exceptions ctx ?(final=(fun() -> ())) f p = | _ :: l -> l (* Otherwise, ignore topmost frame position. *) in let msg = get_exc_error_message ctx v stack (if p' = null_pos then p else p') in - GlobalState.get_ctx_ref := prev; + reset_ctx(); final(); Error.error msg null_pos end @@ -183,7 +162,7 @@ let catch_exceptions ctx ?(final=(fun() -> ())) f p = final(); None | exc -> - GlobalState.get_ctx_ref := prev; + reset_ctx(); final(); raise exc in diff --git a/src/macro/eval/evalHash.ml b/src/macro/eval/evalHash.ml index 2a99b2b1..09e920c0 100644 --- a/src/macro/eval/evalHash.ml +++ b/src/macro/eval/evalHash.ml @@ -43,12 +43,16 @@ let key_max = hash "max" let key_file = hash "file" let key_len = hash "len" let key_message = hash "message" +let key_name = hash "name" +let key_error = hash "error" let key_exception_message = hash "__exceptionMessage" let key_native_exception = hash "__nativeException" let key_native_stack = hash "__nativeStack" let key_Array = hash "Array" let key_eval_Vector = hash "eval.Vector" let key_String = hash "String" +let key_haxe_Exception = hash "haxe.Exception" +let key_haxe_ds_Option = hash "haxe.ds.Option" let key_haxe_ds_StringMap = hash "haxe.ds.StringMap" let key_haxe_ds_IntMap = hash "haxe.ds.IntMap" let key_haxe_ds_ObjectMap = hash "haxe.ds.ObjectMap" @@ -136,6 +140,7 @@ let key_sys_net_Mutex = hash "sys.thread.Mutex" let key_sys_net_Lock = hash "sys.thread.Lock" let key_sys_net_Tls = hash "sys.thread.Tls" let key_sys_net_Deque = hash "sys.thread.Deque" +let key_sys_thread_EventLoop = hash "sys.thread.EventLoop" let key_mbedtls_Config = hash "mbedtls.Config" let key_mbedtls_CtrDrbg = hash "mbedtls.CtrDrbg" @@ -143,3 +148,58 @@ let key_mbedtls_Entropy = hash "mbedtls.Entropy" let key_mbedtls_PkContext = hash "mbedtls.PkContext" let key_mbedtls_Ssl = hash "mbedtls.Ssl" let key_mbedtls_X509Crt = hash "mbedtls.X509Crt" + +let key_eval_luv_Result = hash "eval.luv.Result" +let key_eval_luv_LuvException = hash "eval.luv.LuvException" +let key_eval_luv_ReceiveHandle = hash "eval.luv.ReceiveHandle" +let key_eval_luv_AddressFamily = hash "eval.luv.AddressFamily" +let key_eval_luv_SocketType = hash "eval.luv.SocketType" +let key_onExit = hash "onExit" +let key_environment = hash "environment" +let key_redirect = hash "redirect" +let key_workingDirectory = hash "workingDirectory" +let key_uid = hash "uid" +let key_gid = hash "gid" +let key_windowsVerbatimArguments = hash "windowsVerbatimArguments" +let key_detached = hash "detached" +let key_windowsHide = hash "windowsHide" +let key_windowsHideConsole = hash "windowsHideConsole" +let key_windowsHideGui = hash "windowsHideGui" +let key_request = hash "request" +let key_family = hash "family" +let key_sockType = hash "sockType" +let key_protocol = hash "protocol" +let key_flags = hash "flags" +let key_addr = hash "addr" +let key_data = hash "data" +let key_canonName = hash "canonName" +let key_node = hash "node" +let key_service = hash "service" +let key_sec = hash "sec" +let key_nsec = hash "nsec" +let key_usec = hash "usec" +let key_blksize = hash "blksize" +let key_blocks = hash "blocks" +let key_gen = hash "gen" +let key_atim = hash "atim" +let key_mtim = hash "mtim" +let key_ctim = hash "ctim" +let key_birthtim = hash "birthtim" +let key_width = hash "width" +let key_height = hash "height" +let key_type = hash "type" +let key_bsize = hash "bsize" +let key_bfree = hash "bfree" +let key_bavail = hash "bavail" +let key_files = hash "files" +let key_ffree = hash "ffree" +let key_fspare = hash "fspare" +let key_kind = hash "kind" +let key_end = hash "end" +let key_events = hash "events" +let key_isInternal = hash "isInternal" +let key_physical = hash "physical" +let key_address = hash "address" +let key_netmask = hash "netmask" +let key_previous = hash "previous" +let key_current = hash "current" \ No newline at end of file diff --git a/src/macro/eval/evalIntegers.ml b/src/macro/eval/evalIntegers.ml new file mode 100644 index 00000000..e603e934 --- /dev/null +++ b/src/macro/eval/evalIntegers.ml @@ -0,0 +1,270 @@ +module GInt64 = Int64 +module GInt32 = Int32 + +open Globals +open EvalContext +open EvalExceptions +open EvalValue +open EvalEncode +open EvalDecode +open EvalHash +open EvalMisc +open Unsigned +open Signed + +let encode_haxe_i64 low high = + let vi = create_instance key_haxe__Int64____Int64 in + set_instance_field vi key_high (vint32 high); + set_instance_field vi key_low (vint32 low); + vinstance vi + +let encode_haxe_i64_direct i64 = + let low = GInt64.to_int32 i64 in + let high = GInt64.to_int32 (GInt64.shift_right_logical i64 32) in + encode_haxe_i64 low high + +let decode_haxe_i64 v = + match v with + | VInstance vi when is v key_haxe__Int64____Int64 -> + let high = decode_i32 (vi.ifields.(get_instance_field_index_raise vi.iproto key_high)) + and low = decode_i32 (vi.ifields.(get_instance_field_index_raise vi.iproto key_low)) in + let high64 = GInt64.shift_left (Int32.to_int64 high) 32 + and low64 = Int32.to_int64 low in + GInt64.logor high64 low64 + | _ -> + unexpected_value v "haxe.Int64" + +let decode_u64 = function + | VUInt64 u -> u + | v -> unexpected_value v "eval.integers.UInt64" + +let decode_i64 = function + | VInt64 i -> i + | v -> unexpected_value v "eval.integers.Int64" + +let encode_size_t t = + VUInt64 (UInt64.of_int64 (Size_t.to_int64 t)) + +let decode_size_t = function + | VUInt64 u -> Size_t.of_int64 (UInt64.to_int64 u) + | v -> unexpected_value v "eval.integers.UInt64" + +let uint64_fields = [ + "MAX", VUInt64 UInt64.max_int; + "ZERO", VUInt64 UInt64.zero; + "ONE", VUInt64 UInt64.one; + "ofInt", vfun1 (fun v -> + let i32 = decode_i32 v in + VUInt64 (UInt64.of_int64 (GInt64.of_int32 i32)) + ); + "ofString", vfun1 (fun v -> + let s = decode_string v in + try VUInt64 (UInt64.of_string s) + with Failure _ -> throw_string "The string is not a valid UInt64 representation" null_pos + ); + "max", vfun2 (fun v1 v2 -> + let a = decode_u64 v1 + and b = decode_u64 v2 in + VUInt64 (UInt64.max a b) + ); + "min", vfun2 (fun v1 v2 -> + let a = decode_u64 v1 + and b = decode_u64 v2 in + VUInt64 (UInt64.min a b) + ); + "compare", vfun2 (fun v1 v2 -> + let a = decode_u64 v1 + and b = decode_u64 v2 in + vint (UInt64.compare a b) + ); + "toInt", vfun1 (fun v -> + let u = decode_u64 v in + vint32 (UInt32.to_int32 (UInt64.to_uint32 u)) + ); + "toInt64", vfun1 (fun v -> + let u = decode_u64 v in + VInt64 (Int64.of_int64 (UInt64.to_int64 u)) + ); + "toString", vfun1 (fun v -> + let u = decode_u64 v in + EvalString.vstring (EvalString.create_ascii (UInt64.to_string u)) + ); + "successor", vfun1 (fun v -> + let u = decode_u64 v in + VUInt64 (UInt64.succ u) + ); + "predecessor", vfun1 (fun v -> + let u = decode_u64 v in + VUInt64 (UInt64.pred u) + ); + "remainder", vfun2 (fun v1 v2 -> + let a = decode_u64 v1 + and b = decode_u64 v2 in + try VUInt64 (UInt64.rem a b) + with e -> throw_string (Printexc.to_string e) null_pos + ); + "add", vfun2 (fun v1 v2 -> + let a = decode_u64 v1 + and b = decode_u64 v2 in + VUInt64 (UInt64.add a b) + ); + "sub", vfun2 (fun v1 v2 -> + let a = decode_u64 v1 + and b = decode_u64 v2 in + VUInt64 (UInt64.sub a b) + ); + "mul", vfun2 (fun v1 v2 -> + let a = decode_u64 v1 + and b = decode_u64 v2 in + VUInt64 (UInt64.mul a b) + ); + "div", vfun2 (fun v1 v2 -> + let a = decode_u64 v1 + and b = decode_u64 v2 in + try VUInt64 (UInt64.div a b) + with e -> throw_string (Printexc.to_string e) null_pos + ); + "logand", vfun2 (fun v1 v2 -> + let a = decode_u64 v1 + and b = decode_u64 v2 in + VUInt64 (UInt64.logand a b) + ); + "logor", vfun2 (fun v1 v2 -> + let a = decode_u64 v1 + and b = decode_u64 v2 in + VUInt64 (UInt64.logor a b) + ); + "logxor", vfun2 (fun v1 v2 -> + let a = decode_u64 v1 + and b = decode_u64 v2 in + VUInt64 (UInt64.logxor a b) + ); + "shift_left", vfun2 (fun v1 v2 -> + let u = decode_u64 v1 + and i = decode_int v2 in + VUInt64 (UInt64.shift_left u i) + ); + "shift_right", vfun2 (fun v1 v2 -> + let u = decode_u64 v1 + and i = decode_int v2 in + VUInt64 (UInt64.shift_right u i) + ); + "lognot", vfun1 (fun v -> + let u = decode_u64 v in + VUInt64 (UInt64.lognot u) + ); +] + +let int64_fields = [ + "MAX", VInt64 Int64.max_int; + "MIN", VInt64 Int64.min_int; + "ZERO", VInt64 Int64.zero; + "ONE", VInt64 Int64.one; + "ofInt", vfun1 (fun v -> + let i32 = decode_i32 v in + VInt64 (Int64.of_int64 (GInt64.of_int32 i32)) + ); + "ofString", vfun1 (fun v -> + let s = decode_string v in + try VInt64 (Int64.of_string s) + with Failure _ -> throw_string "The string is not a valid Int64 representation" null_pos + ); + "ofHxInt64", vfun1 (fun v -> + VInt64 (decode_haxe_i64 v) + ); + "max", vfun2 (fun v1 v2 -> + let a = decode_i64 v1 + and b = decode_i64 v2 in + VInt64 (Int64.max a b) + ); + "min", vfun2 (fun v1 v2 -> + let a = decode_i64 v1 + and b = decode_i64 v2 in + VInt64 (Int64.min a b) + ); + "compare", vfun2 (fun v1 v2 -> + let a = decode_i64 v1 + and b = decode_i64 v2 in + vint (Int64.compare a b) + ); + "toInt", vfun1 (fun v -> + let i = decode_i64 v in + vint32 (GInt64.to_int32 i) + ); + "toUInt64", vfun1 (fun v -> + let i = decode_i64 v in + VUInt64 (UInt64.of_int64 i) + ); + "toHxInt64", vfun1 (fun v -> + let i = decode_i64 v in + encode_haxe_i64_direct i + ); + "toString", vfun1 (fun v -> + let i = decode_i64 v in + EvalString.vstring (EvalString.create_ascii (Int64.to_string i)) + ); + "successor", vfun1 (fun v -> + let i = decode_i64 v in + VInt64 (Int64.succ i) + ); + "predecessor", vfun1 (fun v -> + let i = decode_i64 v in + VInt64 (Int64.pred i) + ); + "remainder", vfun2 (fun v1 v2 -> + let a = decode_i64 v1 + and b = decode_i64 v2 in + try VInt64 (Int64.rem a b) + with e -> throw_string (Printexc.to_string e) null_pos + ); + "add", vfun2 (fun v1 v2 -> + let a = decode_i64 v1 + and b = decode_i64 v2 in + VInt64 (Int64.add a b) + ); + "sub", vfun2 (fun v1 v2 -> + let a = decode_i64 v1 + and b = decode_i64 v2 in + VInt64 (Int64.sub a b) + ); + "mul", vfun2 (fun v1 v2 -> + let a = decode_i64 v1 + and b = decode_i64 v2 in + VInt64 (Int64.mul a b) + ); + "div", vfun2 (fun v1 v2 -> + let a = decode_i64 v1 + and b = decode_i64 v2 in + try VInt64 (Int64.div a b) + with e -> throw_string (Printexc.to_string e) null_pos + ); + "logand", vfun2 (fun v1 v2 -> + let a = decode_i64 v1 + and b = decode_i64 v2 in + VInt64 (Int64.logand a b) + ); + "logor", vfun2 (fun v1 v2 -> + let a = decode_i64 v1 + and b = decode_i64 v2 in + VInt64 (Int64.logor a b) + ); + "logxor", vfun2 (fun v1 v2 -> + let a = decode_i64 v1 + and b = decode_i64 v2 in + VInt64 (Int64.logxor a b) + ); + "shift_left", vfun2 (fun v1 v2 -> + let i64 = decode_i64 v1 + and i = decode_int v2 in + VInt64 (Int64.shift_left i64 i) + ); + "shift_right", vfun2 (fun v1 v2 -> + let i64 = decode_i64 v1 + and i = decode_int v2 in + VInt64 (Int64.shift_right i64 i) + ); + "lognot", vfun1 (fun v -> + let i = decode_i64 v in + VInt64 (Int64.lognot i) + ); +] \ No newline at end of file diff --git a/src/macro/eval/evalJit.ml b/src/macro/eval/evalJit.ml index 1fa1d924..b3e82e3c 100644 --- a/src/macro/eval/evalJit.ml +++ b/src/macro/eval/evalJit.ml @@ -62,7 +62,7 @@ open EvalJitContext let rec op_assign ctx jit e1 e2 = match e1.eexpr with | TLocal var -> let exec = jit_expr jit false e2 in - if var.v_capture then emit_capture_write (get_capture_slot jit var) exec + if has_var_flag var VCaptured then emit_capture_write (get_capture_slot jit var) exec else emit_local_write (get_slot jit var.v_id e1.epos) exec | TField(ef,fa) -> let name = hash (field_name fa) in @@ -74,7 +74,7 @@ let rec op_assign ctx jit e1 e2 = match e1.eexpr with | FStatic({cl_path=path},_) | FEnum({e_path=path},_) -> let proto = get_static_prototype jit.ctx (path_hash path) ef.epos in emit_proto_field_write proto (get_proto_field_index proto name) exec2 - | FInstance(c,_,_) when not c.cl_interface -> + | FInstance(c,_,_) when not (has_class_flag c CInterface) -> let proto = get_instance_prototype jit.ctx (path_hash c.cl_path) ef.epos in let i = get_instance_field_index proto name ef.epos in emit_instance_field_write exec1 ef.epos i exec2 @@ -111,7 +111,7 @@ let rec op_assign ctx jit e1 e2 = match e1.eexpr with and op_assign_op jit op e1 e2 prefix = match e1.eexpr with | TLocal var -> let exec = jit_expr jit false e2 in - if var.v_capture then emit_capture_read_write (get_capture_slot jit var) exec op prefix + if has_var_flag var VCaptured then emit_capture_read_write (get_capture_slot jit var) exec op prefix else emit_local_read_write (get_slot jit var.v_id e1.epos) exec op prefix | TField(ef,fa) -> let name = hash (field_name fa) in @@ -121,7 +121,7 @@ and op_assign_op jit op e1 e2 prefix = match e1.eexpr with | FStatic({cl_path=path},_) -> let proto = get_static_prototype jit.ctx (path_hash path) ef.epos in emit_proto_field_read_write proto (get_proto_field_index proto name) exec2 op prefix - | FInstance(c,_,_) when not c.cl_interface -> + | FInstance(c,_,_) when not (has_class_flag c CInterface) -> let proto = get_instance_prototype jit.ctx (path_hash c.cl_path) ef.epos in let i = get_instance_field_index proto name ef.epos in emit_instance_field_read_write exec1 ef.epos i exec2 op prefix @@ -163,7 +163,7 @@ and unop jit op flag e1 p = emit_op_sub p (fun _ -> vint32 (Int32.minus_one)) exec | Increment -> begin match Texpr.skip e1 with - | {eexpr = TLocal v} when not v.v_capture -> + | {eexpr = TLocal v} when not (has_var_flag v VCaptured) -> let slot = get_slot jit v.v_id e1.epos in if flag = Prefix then emit_local_incr_prefix slot e1.epos else emit_local_incr_postfix slot e1.epos @@ -172,6 +172,10 @@ and unop jit op flag e1 p = end | Decrement -> op_decr jit e1 (flag = Prefix) p + | Spread -> + match flag with + | Postfix -> die ~p:p "Postfix spread operator is not supported" __LOC__ + | Prefix -> jit_expr jit false e1 and jit_default jit return def = match def with @@ -410,7 +414,7 @@ and jit_expr jit return e = let name = hash (field_name fa) in let execs = List.map (jit_expr jit false) el in let is_final c cf = - c.cl_final || (has_class_field_flag cf CfFinal) || + has_class_flag c CFinal || (has_class_field_flag cf CfFinal) || (* In interp mode we can assume that a field is final if it is not overridden. We cannot do that in macro mode because overriding fields might be added after jitting this call. *) @@ -441,6 +445,11 @@ and jit_expr jit return e = | [exec1;exec2] -> emit_string_cca exec1 exec2 e.epos | _ -> die "" __LOC__ end + | FStatic({cl_path=[],"StringTools"},{cf_name="unsafeCodeAt"}) -> + begin match execs with + | [exec1;exec2] -> emit_string_cca_unsafe exec1 exec2 e.epos + | _ -> die "" __LOC__ + end | FEnum({e_path=path},ef) -> let key = path_hash path in let pos = Some e.epos in @@ -452,11 +461,11 @@ and jit_expr jit return e = | FInstance(c,_,cf) when is_proper_method cf -> if not (is_final c cf) then default() - else if not c.cl_interface then + else if not (has_class_flag c CInterface) then instance_call c (* If we have exactly one implementer, use it instead of the super class/interface. *) else if not ctx.is_macro && c.cl_implements = [] && c.cl_super = None then begin match c.cl_descendants with - | [c'] when not c'.cl_interface && is_final c' cf -> + | [c'] when not (has_class_flag c' CInterface) && is_final c' cf -> instance_call c' | _ -> default() @@ -517,7 +526,7 @@ and jit_expr jit return e = end (* read *) | TLocal var -> - if var.v_capture then emit_capture_read (get_capture_slot jit var) + if has_var_flag var VCaptured then emit_capture_read (get_capture_slot jit var) else emit_local_read (get_slot jit var.v_id e.epos) | TField(e1,fa) -> let name = hash (field_name fa) in @@ -529,7 +538,7 @@ and jit_expr jit return e = | FInstance({cl_path=path},_,{cf_kind = Method (MethNormal | MethInline)}) -> let proto = get_static_prototype ctx (path_hash path) e1.epos in emit_proto_field_read proto (get_proto_field_index proto name) - | FInstance(c,_,_) when not c.cl_interface -> + | FInstance(c,_,_) when not (has_class_flag c CInterface) -> let proto = get_instance_prototype ctx (path_hash c.cl_path) e1.epos in let i = get_instance_field_index proto name e1.epos in begin match e1.eexpr with @@ -685,25 +694,29 @@ and jit_tfunction jit static pos tf = fl,exec and get_env_creation jit static file info = - create_env_info static 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 (Hashtbl.length jit.captures) + +let jit_timer ctx f = + Std.finally (Timer.timer [(if ctx.is_macro then "macro" else "interp");"jit"]) f () (* Creates a [EvalValue.vfunc] of function [tf], which can be [static] or not. *) let jit_tfunction ctx key_type key_field tf static pos = - let t = Timer.timer [(if ctx.is_macro then "macro" else "interp");"jit"] in - (* Create a new JitContext with an initial scope *) - let jit = EvalJitContext.create ctx in - let fl,exec = jit_tfunction jit static pos tf in - (* Create the [vfunc] instance depending on the number of arguments. *) - let hasret = jit.has_nonfinal_return in - let eci = get_env_creation jit static tf.tf_expr.epos.pfile (EKMethod(key_type,key_field)) in - let f = if hasret then create_function ctx eci exec fl else create_function_noret ctx eci exec fl in - t(); - f + let f () = + (* Create a new JitContext with an initial scope *) + let jit = EvalJitContext.create ctx in + let fl,exec = jit_tfunction jit static pos tf in + (* Create the [vfunc] instance depending on the number of arguments. *) + let hasret = jit.has_nonfinal_return in + let eci = get_env_creation jit static tf.tf_expr.epos.pfile (EKMethod(key_type,key_field)) in + if hasret then create_function ctx eci exec fl else create_function_noret ctx eci exec fl + in + jit_timer ctx f (* JITs expression [e] to a function. This is used for expressions that are not in a method. *) let jit_expr ctx e = - let t = Timer.timer [(if ctx.is_macro then "macro" else "interp");"jit"] in - let jit = EvalJitContext.create ctx in - let f = jit_expr jit false (mk_block e) in - t(); - jit,f \ No newline at end of file + let f () = + let jit = EvalJitContext.create ctx in + let f = jit_expr jit false (mk_block e) in + jit,f + in + jit_timer ctx f \ No newline at end of file diff --git a/src/macro/eval/evalJitContext.ml b/src/macro/eval/evalJitContext.ml index baa40550..a8ad0377 100644 --- a/src/macro/eval/evalJitContext.ml +++ b/src/macro/eval/evalJitContext.ml @@ -111,7 +111,7 @@ let add_local jit var = match jit.scopes with Returns either [Env slot] if the variable is captured or [Local slot] otherwise. *) let declare_local jit var = - if var.v_capture then Env (add_capture jit var true) + if has_var_flag var VCaptured then Env (add_capture jit var true) else Local (add_local jit var) (* @@ -122,7 +122,7 @@ let declare_local jit var = *) let declare_arg jit var = let varacc = add_local jit var in - if var.v_capture then add_capture jit var true,Some varacc else varacc,None + if has_var_flag var VCaptured then add_capture jit var true,Some varacc else varacc,None (* Declares a variable for `this` in context [jit]. *) let declare_local_this jit = match jit.scopes with diff --git a/src/macro/eval/evalLuv.ml b/src/macro/eval/evalLuv.ml new file mode 100644 index 00000000..40f29ea1 --- /dev/null +++ b/src/macro/eval/evalLuv.ml @@ -0,0 +1,2431 @@ +module HaxeError = Error + +open Luv +open Globals +open EvalContext +open EvalExceptions +open EvalValue +open EvalEncode +open EvalDecode +open EvalHash +open EvalMisc +open EvalField +open EvalIntegers + +let encode_uv_error (e:Error.t) = + vint (match e with + | `E2BIG -> 0 + | `EACCES -> 1 + | `EADDRINUSE -> 2 + | `EADDRNOTAVAIL -> 3 + | `EAFNOSUPPORT -> 4 + | `EAGAIN -> 5 + | `EAI_ADDRFAMILY -> 6 + | `EAI_AGAIN -> 7 + | `EAI_BADFLAGS -> 8 + | `EAI_BADHINTS -> 9 + | `EAI_CANCELED -> 10 + | `EAI_FAIL -> 11 + | `EAI_FAMILY -> 12 + | `EAI_MEMORY -> 13 + | `EAI_NODATA -> 14 + | `EAI_NONAME -> 15 + | `EAI_OVERFLOW -> 16 + | `EAI_PROTOCOL -> 17 + | `EAI_SERVICE -> 18 + | `EAI_SOCKTYPE -> 19 + | `EALREADY -> 20 + | `EBADF -> 21 + | `EBUSY -> 22 + | `ECANCELED -> 23 + (* | `ECHARSET -> 24; not defined in Luv *) + | `ECONNABORTED -> 25 + | `ECONNREFUSED -> 26 + | `ECONNRESET -> 27 + | `EDESTADDRREQ -> 28 + | `EEXIST -> 29 + | `EFAULT -> 30 + | `EFBIG -> 31 + | `EHOSTUNREACH -> 32 + | `EINTR -> 33 + | `EINVAL -> 34 + | `EIO -> 35 + | `EISCONN -> 36 + | `EISDIR -> 37 + | `ELOOP -> 38 + | `EMFILE -> 39 + | `EMSGSIZE -> 40 + | `ENAMETOOLONG -> 41 + | `ENETDOWN -> 42 + | `ENETUNREACH -> 43 + | `ENFILE -> 44 + | `ENOBUFS -> 45 + | `ENODEV -> 46 + | `ENOENT -> 47 + | `ENOMEM -> 48 + | `ENONET -> 49 + | `ENOPROTOOPT -> 50 + | `ENOSPC -> 51 + | `ENOSYS -> 52 + | `ENOTCONN -> 53 + | `ENOTDIR -> 54 + | `ENOTEMPTY -> 55 + | `ENOTSOCK -> 56 + | `ENOTSUP -> 57 + | `EPERM -> 58 + | `EPIPE -> 59 + | `EPROTO -> 60 + | `EPROTONOSUPPORT -> 61 + | `EPROTOTYPE -> 62 + | `ERANGE -> 63 + | `EROFS -> 64 + | `ESHUTDOWN -> 65 + | `ESPIPE -> 66 + | `ESRCH -> 67 + | `ETIMEDOUT -> 68 + | `ETXTBSY -> 69 + | `EXDEV -> 70 + | `UNKNOWN -> 71 + | `EOF -> 72 + | `ENXIO -> 73 + | `EMLINK -> 74 + | `ENOTTY -> 75 + | `EFTYPE -> 76 + | `EILSEQ -> 77 + ) + +let decode_uv_error v : Error.t = + match decode_int v with + | 0 -> `E2BIG + | 1 -> `EACCES + | 2 -> `EADDRINUSE + | 3 -> `EADDRNOTAVAIL + | 4 -> `EAFNOSUPPORT + | 5 -> `EAGAIN + | 6 -> `EAI_ADDRFAMILY + | 7 -> `EAI_AGAIN + | 8 -> `EAI_BADFLAGS + | 9 -> `EAI_BADHINTS + | 10 -> `EAI_CANCELED + | 11 -> `EAI_FAIL + | 12 -> `EAI_FAMILY + | 13 -> `EAI_MEMORY + | 14 -> `EAI_NODATA + | 15 -> `EAI_NONAME + | 16 -> `EAI_OVERFLOW + | 17 -> `EAI_PROTOCOL + | 18 -> `EAI_SERVICE + | 19 -> `EAI_SOCKTYPE + | 20 -> `EALREADY + | 21 -> `EBADF + | 22 -> `EBUSY + | 23 -> `ECANCELED + (* | 24 -> `ECHARSET not defined in Luv *) + | 25 -> `ECONNABORTED + | 26 -> `ECONNREFUSED + | 27 -> `ECONNRESET + | 28 -> `EDESTADDRREQ + | 29 -> `EEXIST + | 30 -> `EFAULT + | 31 -> `EFBIG + | 32 -> `EHOSTUNREACH + | 33 -> `EINTR + | 34 -> `EINVAL + | 35 -> `EIO + | 36 -> `EISCONN + | 37 -> `EISDIR + | 38 -> `ELOOP + | 39 -> `EMFILE + | 40 -> `EMSGSIZE + | 41 -> `ENAMETOOLONG + | 42 -> `ENETDOWN + | 43 -> `ENETUNREACH + | 44 -> `ENFILE + | 45 -> `ENOBUFS + | 46 -> `ENODEV + | 47 -> `ENOENT + | 48 -> `ENOMEM + | 49 -> `ENONET + | 50 -> `ENOPROTOOPT + | 51 -> `ENOSPC + | 52 -> `ENOSYS + | 53 -> `ENOTCONN + | 54 -> `ENOTDIR + | 55 -> `ENOTEMPTY + | 56 -> `ENOTSOCK + | 57 -> `ENOTSUP + | 58 -> `EPERM + | 59 -> `EPIPE + | 60 -> `EPROTO + | 61 -> `EPROTONOSUPPORT + | 62 -> `EPROTOTYPE + | 63 -> `ERANGE + | 64 -> `EROFS + | 65 -> `ESHUTDOWN + | 66 -> `ESPIPE + | 67 -> `ESRCH + | 68 -> `ETIMEDOUT + | 69 -> `ETXTBSY + | 70 -> `EXDEV + | 71 -> `UNKNOWN + | 72 -> `EOF + | 73 -> `ENXIO + | 74 -> `EMLINK + | 75 -> `ENOTTY + | 76 -> `EFTYPE + | 77 -> `EILSEQ + | _ -> unexpected_value v "eval.luv.UVError" + +let luv_exception e = + let vi = encode_instance key_eval_luv_LuvException in + match vi with + | VInstance i -> + let msg = EvalString.create_unknown (Error.strerror e) + and error = encode_uv_error e in + set_instance_field i key_exception_message msg; + set_instance_field i key_native_exception error; + set_instance_field i key_error error; + let ctx = get_ctx() in + let eval = get_eval ctx in + (match eval.env with + | Some _ -> + let stack = EvalStackTrace.make_stack_value (call_stack eval) in + set_instance_field i key_native_stack stack; + | None -> ()); + vi + | _ -> + die "" __LOC__ + +let encode_result f result = + let index, args = + match result with + | Result.Ok r -> 0, [|f r|] + | Result.Error e -> 1, [|encode_uv_error e|] + in + encode_enum_value key_eval_luv_Result index args None + +let encode_callback encode_ok_value v_callback result = + let cb = prepare_callback v_callback 1 in + ignore(cb [encode_result encode_ok_value result]) + +let encode_unit () = + vnull + +let encode_unit_result = + encode_result encode_unit + +let encode_unit_callback = + encode_callback encode_unit + +let resolve_result = function + | Result.Ok v -> v + | Result.Error e -> throw (luv_exception e) null_pos + +let decode_loop = function + | VHandle (HLoop t) -> t + | v -> unexpected_value v "eval.luv.Loop" + +let decode_luv_handle v : 'kind Luv.Handle.t = + match decode_handle v with + | HIdle t -> Handle.coerce t + | HTimer t -> Handle.coerce t + | HAsync t -> Handle.coerce t + | HPipe t -> Handle.coerce t + | HTcp t -> Handle.coerce t + | HTty t -> Handle.coerce t + | HUdp t -> Handle.coerce t + | HSignal t -> Handle.coerce t + | HProcess t -> Handle.coerce t + | HFsEvent t -> Handle.coerce t + | HFsPoll t -> Handle.coerce t + | HPrepare t -> Handle.coerce t + | HCheck t -> Handle.coerce t + (* TODO + | HPoll t -> Handle.coerce t + *) + | _ -> unexpected_value v "eval.luv.Handle" + +let decode_socket_handle v : [< `Stream of [< `Pipe | `TCP ] | `UDP ] Luv.Handle.t = + match decode_handle v with + | HTcp t -> Obj.magic t + | HUdp t -> Obj.magic t + | HPipe t -> Obj.magic t + | _ -> unexpected_value v "eval.luv.Handle.SocketHandle" + +let decode_stream v : 'kind Luv.Stream.t = + match decode_handle v with + | HTcp t -> Stream.coerce t + | HTty t -> Stream.coerce t + | HPipe t -> Stream.coerce t + | _ -> unexpected_value v "eval.luv.Stream" + +let decode_idle = function + | VHandle (HIdle t) -> t + | v -> unexpected_value v "eval.luv.Idle" + +let decode_timer = function + | VHandle (HTimer t) -> t + | v -> unexpected_value v "eval.luv.Timer" + +let decode_async = function + | VHandle (HAsync t) -> t + | v -> unexpected_value v "eval.luv.Async" + +let decode_buffer = function + | VHandle (HBuffer t) -> t + | v -> unexpected_value v "eval.luv.Buffer" + +let decode_buffers v = + List.map decode_buffer (decode_array v) + +let encode_buffer b = + VHandle (HBuffer b) + +let decode_sockaddr v = + match decode_handle v with + | HSockAddr t -> t + | _ -> unexpected_value v "eval.luv.SockAddr" + +let encode_sockaddr h = + VHandle (HSockAddr h) + +let decode_tcp = function + | VHandle (HTcp t) -> t + | v -> unexpected_value v "eval.luv.Tcp" + +let decode_udp = function + | VHandle (HUdp t) -> t + | v -> unexpected_value v "eval.luv.Udp" + +let encode_udp udp = + VHandle (HUdp udp) + +let decode_udp_membership v = + match decode_int v with + | 0 -> `LEAVE_GROUP + | 1 -> `JOIN_GROUP + | _ -> unexpected_value v "eval.luv.Udp.UdpMembership" + +let decode_socket_type v : Sockaddr.Socket_type.t = + match decode_enum v with + | 0, [] -> `STREAM + | 1, [] -> `DGRAM + | 2, [] -> `RAW + | 3, [v] -> `OTHER (decode_int v) + | _ -> unexpected_value v "eval.luv.SockAddr.SocketType" + +let decode_address_family v : Sockaddr.Address_family.t = + match decode_enum v with + | 0, [] -> `UNSPEC + | 1, [] -> `INET + | 2, [] -> `INET6 + | 3, [v] -> `OTHER (decode_int v) + | _ -> unexpected_value v "eval.luv.SockAddr.AddressType" + +let encode_address_family (a:Sockaddr.Address_family.t) = + let index,args = + match a with + | `UNSPEC -> 0, [||] + | `INET -> 1, [||] + | `INET6 -> 2, [||] + | `OTHER i -> 3, [|vint i|] + in + encode_enum_value key_eval_luv_AddressFamily index args None + +let encode_socket_type (a:Sockaddr.Socket_type.t) = + let index,args = + match a with + | `STREAM -> 0, [||] + | `DGRAM -> 1, [||] + | `RAW -> 2, [||] + | `OTHER i -> 3, [|vint i|] + in + encode_enum_value key_eval_luv_SocketType index args None + +let decode_pipe = function + | VHandle (HPipe t) -> t + | v -> unexpected_value v "eval.luv.Pipe" + +let decode_tty = function + | VHandle (HTty t) -> t + | v -> unexpected_value v "eval.luv.Tty" + +let decode_file = function + | VHandle (HFile f) -> f + | v -> unexpected_value v "eval.luv.File" + +let decode_signal = function + | VHandle (HSignal t) -> t + | v -> unexpected_value v "eval.luv.Signal" + +let decode_process = function + | VHandle (HProcess t) -> t + | v -> unexpected_value v "eval.luv.Process" + +let decode_prepare = function + | VHandle (HPrepare t) -> t + | v -> unexpected_value v "eval.luv.Prepare" + +let decode_check = function + | VHandle (HCheck t) -> t + | v -> unexpected_value v "eval.luv.Check" + +let decode_file_mode v : File.Mode.t = + match decode_enum v with + | 0,[] -> `IRWXU + | 1,[] -> `IRUSR + | 2,[] -> `IWUSR + | 3,[] -> `IXUSR + | 4,[] -> `IRWXG + | 5,[] -> `IRGRP + | 6,[] -> `IWGRP + | 7,[] -> `IXGRP + | 8,[] -> `IRWXO + | 9,[] -> `IROTH + | 10,[] -> `IWOTH + | 11,[] -> `IXOTH + | 12,[] -> `ISUID + | 13,[] -> `ISGID + | 14,[] -> `ISVTX + | 15,[] -> `IFMT + | 16,[] -> `IFREG + | 17,[] -> `IFDIR + | 18,[] -> `IFBLK + | 19,[] -> `IFCHR + | 20,[] -> `IFLNK + | 21,[] -> `IFIFO + | 22,[v2] -> `NUMERIC (decode_int v2) + | _ -> unexpected_value v "eval.luv.File.FileMode" + +let decode_file_mode_list v = + List.map decode_file_mode (decode_array v) + +let decode_file_request = function + | VHandle (HFileRequest r) -> r + | v -> unexpected_value v "eval.luv.File.FileRequest" + +let encode_timespec (t:File.Stat.timespec) = + encode_obj [ + key_sec, VInt64 (Signed.Long.to_int64 t.sec); + key_nsec, VInt64 (Signed.Long.to_int64 t.nsec) + ] + +let decode_dir v = + match v with + | VHandle (HDir dir) -> dir + | _ -> unexpected_value v "eval.luv.Dir" + +let encode_dirent (de:File.Dirent.t) = + let kind = + match de.kind with + | `UNKNOWN -> 0 + | `FILE -> 1 + | `DIR -> 2 + | `LINK -> 3 + | `FIFO -> 4 + | `SOCKET -> 5 + | `CHAR -> 6 + | `BLOCK -> 7 + in + encode_obj [key_kind,vint kind; key_name,vnative_string de.name] + +let encode_scandir sd = + encode_obj [ + key_next,vfun0 (fun() -> encode_nullable encode_dirent (File.scandir_next sd)); + key_end,vfun0 (fun() -> File.scandir_end sd; vnull); + ] + +let decode_int_flags v = + if v = VNull then [] + else List.map decode_int (decode_array v) + +let decode_file_open_flag v : File.Open_flag.t = + match decode_int v with + | 0 -> `RDONLY + | 1 -> `WRONLY + | 2 -> `RDWR + | 3 -> `CREAT + | 4 -> `EXCL + | 5 -> `EXLOCK + | 6 -> `NOCTTY + | 7 -> `NOFOLLOW + | 8 -> `TEMPORARY + | 9 -> `TRUNC + | 10 -> `APPEND + | 11 -> `DIRECT + | 12 -> `DSYNC + | 13 -> `FILEMAP + | 14 -> `NOATIME + | 15 -> `NONBLOCK + | 16 -> `RANDOM + | 17 -> `SEQUENTIAL + | 18 -> `SHORT_LIVED + | 19 -> `SYMLINK + | 20 -> `SYNC + | _ -> unexpected_value v "eval.luv.File.FileOpenFlag" + +let encode_file_stat (s:File.Stat.t) = + encode_obj [ + key_dev,VUInt64 s.dev; + key_mode, VHandle (HFileModeNumeric s.mode); + key_nlink,VUInt64 s.nlink; + key_uid,VUInt64 s.uid; + key_gid,VUInt64 s.gid; + key_rdev,VUInt64 s.rdev; + key_ino,VUInt64 s.ino; + key_size,VUInt64 s.size; + key_blksize,VUInt64 s.blksize; + key_blocks,VUInt64 s.blocks; + key_flags,VUInt64 s.flags; + key_gen,VUInt64 s.gen; + key_atim,encode_timespec s.atim; + key_mtim,encode_timespec s.mtim; + key_ctim,encode_timespec s.ctim; + key_birthtim,encode_timespec s.birthtim; + ] + +let encode_file_statfs (s:File.Statfs.t) = + encode_obj [ + key_type, VUInt64 s.type_; + key_bsize, VUInt64 s.bsize; + key_blocks, VUInt64 s.blocks; + key_bfree, VUInt64 s.bfree; + key_bavail, VUInt64 s.bavail; + key_files, VUInt64 s.files; + key_ffree, VUInt64 s.ffree; + key_fspare, match s.f_spare with u1, u2, u3, u4 -> encode_array [VUInt64 u1; VUInt64 u2; VUInt64 u3; VUInt64 u4] + ] + +let decode_fs_event = function + | VHandle (HFsEvent e) -> e + | v -> unexpected_value v "eval.luv.FsEvent" + +let decode_mutex = function + | VHandle (HMutex m) -> m + | v -> unexpected_value v "eval.luv.Mutex" + +let decode_rwlock = function + | VHandle (HRwLock l) -> l + | v -> unexpected_value v "eval.luv.RwLock" + +let decode_semaphore = function + | VHandle (HSemaphore s) -> s + | v -> unexpected_value v "eval.luv.Semaphore" + +let decode_condition = function + | VHandle (HCondition c) -> c + | v -> unexpected_value v "eval.luv.Condition" + +let decode_barrier = function + | VHandle (HBarrier b) -> b + | v -> unexpected_value v "eval.luv.Barrier" + +let decode_fs_poll = function + | VHandle (HFsPoll p) -> p + | v -> unexpected_value v "eval.luv.FsPoll" + +let uv_error_fields = [ + "toString", vfun1 (fun v -> + let e = decode_uv_error v in + EvalString.create_unknown (Error.strerror e) + ); + "errName", vfun1 (fun v -> + let e = decode_uv_error v in + EvalString.create_unknown (Error.err_name e) + ); + "translateSysError", vfun1 (fun v -> + let e = decode_int v in + encode_uv_error (Error.translate_sys_error e) + ); + "setOnUnhandledException", vfun1 (fun v -> + let cb = prepare_callback v 1 in + Error.set_on_unhandled_exception (fun ex -> + let msg = + match ex with + | HaxeError.Error (Custom msg,_) -> + (* Eval interpreter rethrows runtime exceptions as `Custom "Exception message\nException stack"` *) + (try fst (ExtString.String.split msg "\n") + with _ -> msg) + | HaxeError.Error (err,_) -> HaxeError.error_msg err + | _ -> Printexc.to_string ex + in + let e = create_haxe_exception ~stack:(get_ctx()).exception_stack msg in + ignore(cb [e]) + ); + vnull + ); +] + +let loop_fields = [ + "run", vfun2 (fun v1 v2 -> + let loop = decode_loop v1 + and mode = + match decode_int v2 with + | 0 -> `DEFAULT + | 1 -> `ONCE + | 2 -> `NOWAIT + | _ -> unexpected_value v2 "valid loop run mode" + in + vbool (Loop.run ~loop ~mode ()) + ); + "stop", vfun1 (fun v -> + let loop = decode_loop v in + Loop.stop loop; + vnull + ); + "init", vfun0 (fun () -> + encode_result (fun l -> VHandle (HLoop l)) (Loop.init()) + ); + "close", vfun1 (fun v -> + let loop = decode_loop v in + encode_unit_result (Loop.close loop) + ); + "alive", vfun1 (fun v -> + let loop = decode_loop v in + vbool (Loop.alive loop) + ); + "defaultLoop", vfun0 (fun () -> + VHandle (HLoop (Loop.default())) + ); + "libraryShutdown", vfun0 (fun () -> + Loop.library_shutdown(); + vnull + ); + "now", vfun1 (fun v -> + let loop = decode_loop v in + VUInt64 (Loop.now loop) + ); + "updateTime", vfun1 (fun v -> + let loop = decode_loop v in + Loop.update_time loop; + vnull + ); +] + +let handle_fields = [ + "close", vfun2 (fun v1 v2 -> + let handle = decode_luv_handle v1 + and cb = prepare_callback v2 0 in + Handle.close handle (fun() -> ignore(cb [])); + vnull + ); + "isActive", vfun1 (fun v -> + let handle = decode_luv_handle v in + vbool (Handle.is_active handle) + ); + "isClosing", vfun1 (fun v -> + let handle = decode_luv_handle v in + vbool (Handle.is_closing handle) + ); + "ref", vfun1 (fun v -> + let handle = decode_luv_handle v in + Handle.ref handle; + vnull + ); + "unref", vfun1 (fun v -> + let handle = decode_luv_handle v in + Handle.unref handle; + vnull + ); + "hasRef", vfun1 (fun v -> + let handle = decode_luv_handle v in + vbool (Handle.has_ref handle) + ); + "sendBufferSize", vfun1 (fun v -> + let handle = decode_socket_handle v in + encode_result vint (Handle.send_buffer_size handle) + ); + "setSendBufferSize", vfun2 (fun v1 v2 -> + let handle = decode_socket_handle v1 + and size = decode_int v2 in + encode_unit_result (Handle.set_send_buffer_size handle size) + ); + "recvBufferSize", vfun1 (fun v -> + let handle = decode_socket_handle v in + encode_result vint (Handle.recv_buffer_size handle) + ); + "setRendBufferSize", vfun2 (fun v1 v2 -> + let handle = decode_socket_handle v1 + and size = decode_int v2 in + encode_unit_result (Handle.set_recv_buffer_size handle size) + ); +] + +let idle_fields = [ + "init", vfun1 (fun v -> + let loop = decode_loop v in + encode_result (fun i -> VHandle (HIdle i)) (Idle.init ~loop ()) + ); + "start", vfun2 (fun v1 v2 -> + let idle = decode_idle v1 in + let cb = prepare_callback v2 0 in + encode_unit_result (Idle.start idle (fun() -> ignore(cb []))); + ); + "stop", vfun1 (fun v -> + let idle = decode_idle v in + encode_unit_result (Idle.stop idle) + ); +] + +let timer_fields = [ + "init", vfun1 (fun v -> + let loop = decode_loop v in + encode_result (fun i -> VHandle (HTimer i)) (Timer.init ~loop ()) + ); + "start", vfun4 (fun v1 v2 v3 v4 -> + let timer = decode_timer v1 + and cb = prepare_callback v2 0 + and timeout = decode_int v3 + and repeat = default_int v4 0 in + encode_unit_result (Timer.start ~repeat timer timeout (fun() -> ignore(cb []))); + ); + "stop", vfun1 (fun v -> + let timer = decode_timer v in + encode_unit_result (Timer.stop timer) + ); + "again", vfun1 (fun v -> + let timer = decode_timer v in + encode_unit_result (Timer.again timer) + ); + "set_repeat", vfun2 (fun v1 v2 -> + let timer = decode_timer v1 + and repeat = decode_int v2 in + Timer.set_repeat timer repeat; + vint repeat + ); + "get_repeat", vfun1 (fun v1 -> + let timer = decode_timer v1 in + vint (Timer.get_repeat timer) + ); + "get_dueIn", vfun1 (fun v1 -> + let timer = decode_timer v1 in + vint (Timer.get_due_in timer) + ); +] + +let async_fields = [ + "init", vfun2 (fun v1 v2 -> + let loop = decode_loop v1 + and cb = prepare_callback v2 1 in + let callback async = ignore(cb [VHandle (HAsync async)]) in + encode_result (fun i -> VHandle (HAsync i)) (Async.init ~loop callback) + ); + "send", vfun1 (fun v -> + let async = decode_async v in + encode_unit_result (Async.send async); + ); +] + +let buffer_get getter = vfun2 (fun v1 v2 -> + let buffer = decode_buffer v1 + and index = decode_int v2 in + vint (int_of_char (getter buffer index)) +) + +let buffer_set setter = vfun3 (fun v1 v2 v3 -> + let buffer = decode_buffer v1 + and index = decode_int v2 + and byte = decode_int v3 in + setter buffer index (char_of_int byte); + v3 +) + +let buffer_fields = [ + "create", vfun1 (fun v -> + let size = decode_int v in + encode_buffer (Buffer.create size) + ); + "fromNativeString", vfun1 (fun v -> + let s = decode_native_string v in + encode_buffer (Buffer.from_string s) + ); + "fromString", vfun1 (fun v -> + let s = decode_string v in + encode_buffer (Buffer.from_string s) + ); + "fromBytes", vfun1 (fun v -> + let b = decode_bytes v in + encode_buffer (Buffer.from_bytes b) + ); + "totalSize", vfun1 (fun v -> + let l = decode_buffers v in + vint (Buffer.total_size l) + ); + "drop", vfun2 (fun v1 v2 -> + let l = decode_buffers v1 + and count = decode_int v2 + and encode_buffer buffer = encode_buffer buffer in + encode_array (List.map encode_buffer (Buffer.drop l count)) + ); + "size", vfun1 (fun v -> + let buffer = decode_buffer v in + vint (Buffer.size buffer) + ); + "get", buffer_get Buffer.get; + "unsafeGet", buffer_get Buffer.unsafe_get; + "set", buffer_set Buffer.set; + "unsafeSet", buffer_set Buffer.unsafe_set; + "sub", vfun3 (fun v1 v2 v3 -> + let buffer = decode_buffer v1 + and offset = decode_int v2 + and length = decode_int v3 in + encode_buffer (Buffer.sub buffer offset length) + ); + "blit", vfun2 (fun v1 v2 -> + let buffer = decode_buffer v1 + and destination = decode_buffer v2 in + Buffer.blit buffer destination; + vnull + ); + "fill", vfun2 (fun v1 v2 -> + let buffer = decode_buffer v1 + and byte = decode_int v2 in + Buffer.fill buffer (char_of_int byte); + vnull + ); + "toString", vfun1 (fun v -> + let buffer = decode_buffer v in + EvalString.create_unknown (Buffer.to_string buffer) + ); + "toNativeString", vfun1 (fun v -> + let buffer = decode_buffer v in + vnative_string (Buffer.to_string buffer) + ); + "toBytes", vfun1 (fun v -> + let buffer = decode_buffer v in + encode_bytes (Buffer.to_bytes buffer) + ); + "blitToBytes", vfun3 (fun v1 v2 v3 -> + let buffer = decode_buffer v1 + and destination = decode_bytes v2 + and offset = decode_int v3 in + Buffer.blit_to_bytes buffer destination offset; + vnull + ); + "blitFromBytes", vfun3 (fun v1 v2 v3 -> + let buffer = decode_buffer v1 + and source = decode_bytes v2 + and offset = decode_int v3 in + Buffer.blit_from_bytes buffer source offset; + vnull + ); + "blitFromString", vfun3 (fun v1 v2 v3 -> + let buffer = decode_buffer v1 + and source = decode_native_string v2 + and offset = decode_int v3 in + Buffer.blit_from_string buffer source offset; + vnull + ); +] + +let sockaddr_fields = [ + "get_port", vfun1 (fun v -> + let a = decode_sockaddr v in + encode_nullable vint (Sockaddr.port a) + ); + "ipv4", vfun2 (fun v1 v2 -> + let host = decode_string v1 + and port = decode_int v2 in + encode_result encode_sockaddr (Sockaddr.ipv4 host port) + ); + "ipv6", vfun2 (fun v1 v2 -> + let host = decode_string v1 + and port = decode_int v2 in + encode_result encode_sockaddr (Sockaddr.ipv6 host port) + ); + "toString", vfun1 (fun v -> + let a = decode_sockaddr v in + match Sockaddr.to_string a with + | Some s -> EvalString.create_unknown s + | None -> EvalString.vstring (EvalString.create_ascii "") + ); +] + +let tcp_fields = [ + "init", vfun2 (fun v1 v2 -> + let loop = decode_loop v1 + and domain = decode_optional decode_address_family v2 in + let tcp = TCP.init ~loop ?domain () in + encode_result (fun t -> VHandle (HTcp t)) tcp + ); + "noDelay", vfun2 (fun v1 v2 -> + let tcp = decode_tcp v1 + and value = decode_bool v2 in + encode_unit_result (TCP.nodelay tcp value) + ); + "keepAlive", vfun2 (fun v1 v2 -> + let tcp = decode_tcp v1 + and value = decode_option decode_int v2 in + encode_unit_result (TCP.keepalive tcp value) + ); + "simultaneousAccepts", vfun2 (fun v1 v2 -> + let tcp = decode_tcp v1 + and value = decode_bool v2 in + encode_unit_result (TCP.simultaneous_accepts tcp value) + ); + "bind", vfun3 (fun v1 v2 v3 -> + let tcp = decode_tcp v1 + and addr = decode_sockaddr v2 + and ipv6only = decode_optional decode_bool v3 in + encode_unit_result (TCP.bind ?ipv6only tcp addr) + ); + "getSockName", vfun1 (fun v -> + let tcp = decode_tcp v in + encode_result encode_sockaddr (TCP.getsockname tcp) + ); + "getPeerName", vfun1 (fun v -> + let tcp = decode_tcp v in + encode_result encode_sockaddr (TCP.getpeername tcp) + ); + "connect", vfun3 (fun v1 v2 v3 -> + let tcp = decode_tcp v1 + and addr = decode_sockaddr v2 in + TCP.connect tcp addr (encode_unit_callback v3); + vnull + ); + "closeReset", vfun2 (fun v1 v2 -> + let tcp = decode_tcp v1 in + TCP.close_reset tcp (encode_unit_callback v2); + vnull + ); +] + +let udp_fields = [ + "init", vfun3 (fun v1 v2 v3 -> + let loop = decode_loop v1 + and domain = decode_optional decode_address_family v2 + and recvmmsg = decode_optional decode_bool v3 in + let udp = UDP.init ~loop ?domain ?recvmmsg () in + encode_result encode_udp udp + ); + "bind", vfun4 (fun v1 v2 v3 v4 -> + let udp = decode_udp v1 + and addr = decode_sockaddr v2 + and ipv6only = decode_optional decode_bool v3 + and reuseaddr = decode_optional decode_bool v4 in + encode_unit_result (UDP.bind ?ipv6only ?reuseaddr udp addr) + ); + "connect", vfun2 (fun v1 v2 -> + let udp = decode_udp v1 + and addr = decode_sockaddr v2 in + match UDP.Connected.connect udp addr with + | Ok () -> encode_result encode_udp (Ok udp) + | Error e -> encode_result encode_udp (Error e) + ); + "getSockName", vfun1 (fun v -> + let udp = decode_udp v in + encode_result encode_sockaddr (UDP.getsockname udp) + ); + "setMembership", vfun4 (fun v1 v2 v3 v4 -> + let udp = decode_udp v1 + and group = decode_string v2 + and interface = decode_string v3 + and membership = decode_udp_membership v4 in + encode_unit_result (UDP.set_membership udp ~group ~interface membership) + ); + "setSourceMembership", vfun5 (fun v1 v2 v3 v4 v5 -> + let udp = decode_udp v1 + and group = decode_string v2 + and interface = decode_string v3 + and source = decode_string v4 + and membership = decode_udp_membership v5 in + encode_unit_result (UDP.set_source_membership udp ~group ~interface ~source membership) + ); + "setMulticastLoop", vfun2 (fun v1 v2 -> + let udp = decode_udp v1 + and value = decode_bool v2 in + encode_unit_result (UDP.set_multicast_loop udp value) + ); + "setMulticastTtl", vfun2 (fun v1 v2 -> + let udp = decode_udp v1 + and value = decode_int v2 in + encode_unit_result (UDP.set_multicast_ttl udp value) + ); + "setMulticastInterface", vfun2 (fun v1 v2 -> + let udp = decode_udp v1 + and value = decode_string v2 in + encode_unit_result (UDP.set_multicast_interface udp value) + ); + "setBroadcast", vfun2 (fun v1 v2 -> + let udp = decode_udp v1 + and value = decode_bool v2 in + encode_unit_result (UDP.set_broadcast udp value) + ); + "setTtl", vfun2 (fun v1 v2 -> + let udp = decode_udp v1 + and value = decode_int v2 in + encode_unit_result (UDP.set_ttl udp value) + ); + "send", vfun4 (fun v1 v2 v3 v4 -> + let udp = decode_udp v1 + and l = decode_buffers v2 + and addr = decode_sockaddr v3 in + UDP.send udp l addr (encode_unit_callback v4); + vnull + ); + "trySend", vfun3 (fun v1 v2 v3 -> + let udp = decode_udp v1 + and l = decode_buffers v2 + and addr = decode_sockaddr v3 in + encode_unit_result (UDP.try_send udp l addr) + ); + "recvStart", vfun3 (fun v1 v2 v3 -> + let encode (buf,addr,flags) = + let encode_flag = function + | `PARTIAL -> vint 0 + | `MMSG_CHUNK -> vint 1 + | `MMSG_FREE -> vint 2 + in + encode_obj [ + key_data,encode_buffer buf; + key_addr,encode_option encode_sockaddr addr; + key_flags,encode_array (List.map encode_flag flags) + ] + in + let udp = decode_udp v1 + and callback = encode_callback encode v2 + and allocate = + decode_optional (fun v -> + let cb = prepare_callback v 1 in + (fun i -> decode_buffer (cb [vint i])) + ) v3 + in + UDP.recv_start ?allocate udp callback; + vnull + ); + "recvStop", vfun1 (fun v -> + let udp = decode_udp v in + encode_unit_result (UDP.recv_stop udp) + ); + "getSendQueueSize", vfun1 (fun v -> + let udp = decode_udp v in + vint (UDP.get_send_queue_size udp) + ); + "getSendQueueCount", vfun1 (fun v -> + let udp = decode_udp v in + vint (UDP.get_send_queue_count udp) + ); +] + +let connected_udp_fields = [ + "disconnect", vfun1 (fun v -> + let udp = decode_udp v in + encode_unit_result (UDP.Connected.disconnect udp) + ); + "getPeerName", vfun1 (fun v -> + let udp = decode_udp v in + encode_result encode_sockaddr (UDP.Connected.getpeername udp) + ); + "send", vfun3 (fun v1 v2 v3 -> + let udp = decode_udp v1 + and l = decode_buffers v2 in + UDP.Connected.send udp l (encode_unit_callback v3); + vnull + ); + "send", vfun2 (fun v1 v2 -> + let udp = decode_udp v1 + and l = decode_buffers v2 in + encode_unit_result (UDP.Connected.try_send udp l) + ); +] + +let pipe_fields = [ + "init", vfun2 (fun v1 v2 -> + let loop = decode_loop v1 + and for_handle_passing = decode_optional decode_bool v2 in + encode_result (fun p -> VHandle (HPipe p)) (Pipe.init ~loop ?for_handle_passing ()) + ); + "bind", vfun2 (fun v1 v2 -> + let pipe = decode_pipe v1 + and name = decode_native_string v2 in + encode_unit_result (Pipe.bind pipe name) + ); + "connect", vfun3 (fun v1 v2 v3 -> + let pipe = decode_pipe v1 + and target = decode_native_string v2 in + Pipe.connect pipe target (encode_unit_callback v3); + vnull + ); + "getSockName", vfun1 (fun v -> + let pipe = decode_pipe v in + encode_result vnative_string (Pipe.getsockname pipe) + ); + "getPeerName", vfun1 (fun v -> + let pipe = decode_pipe v in + encode_result vnative_string (Pipe.getpeername pipe) + ); + "pendingInstances", vfun2 (fun v1 v2 -> + let pipe = decode_pipe v1 + and amount = decode_int v2 in + Pipe.pending_instances pipe amount; + vnull + ); + "receiveHandle", vfun1 (fun v -> + let pipe = decode_pipe v in + let index,args = + match Pipe.receive_handle pipe with + | `None -> + 0,[||] + | `TCP assoc -> + 1,[|vfun1 (fun v -> encode_unit_result (assoc (decode_tcp v)))|] + | `Pipe assoc -> + 2,[|vfun1 (fun v -> encode_unit_result (assoc (decode_pipe v)))|] + in + encode_enum_value key_eval_luv_ReceiveHandle index args None + ); + "chmod", vfun2 (fun v1 v2 -> + let pipe = decode_pipe v1 + and mode = + match decode_int v2 with + | 0 -> [`READABLE] + | 1 -> [`WRITABLE] + | 2 -> [`READABLE; `WRITABLE] + | _ -> unexpected_value v2 "eval.luv.Pipe.PipeMode" + in + encode_unit_result (Pipe.chmod pipe mode) + ); +] + +let tty_fields = [ + "init", vfun2 (fun v1 v2 -> + let loop = decode_loop v1 + and file = decode_file v2 in + encode_result (fun tty -> VHandle (HTty tty)) (TTY.init ~loop file) + ); + "setMode", vfun2 (fun v1 v2 -> + let tty = decode_tty v1 + and mode = + match decode_int v2 with + | 0 -> `NORMAL + | 1 -> `RAW + | 2 -> `IO + | _ -> unexpected_value v2 "eval.luv.Tty.TtyMode" + in + encode_unit_result (TTY.set_mode tty mode) + ); + "resetMode", vfun0 (fun () -> + encode_unit_result (TTY.reset_mode ()) + ); + "getWinSize", vfun1 (fun v -> + let tty = decode_tty v in + let encode (w,h) = encode_obj [key_width,vint w; key_height,vint h] in + encode_result encode (TTY.get_winsize tty) + ); + "setVTermState", vfun1 (fun v -> + let state = + match decode_int v with + | 0 -> `SUPPORTED + | 1 -> `UNSUPPORTED + | _ -> unexpected_value v "eval.luv.Tty.VTermState" + in + TTY.set_vterm_state state; + vnull + ); + "getVTermState", vfun0 (fun () -> + let encode state = + vint (match state with + | `SUPPORTED -> 0 + | `UNSUPPORTED -> 1) + in + encode_result encode (TTY.get_vterm_state()) + ); +] + +let stream_fields = [ + "shutdown", vfun2 (fun v1 v2 -> + let stream = decode_stream v1 in + Stream.shutdown stream (encode_unit_callback v2); + vnull + ); + "listen", vfun3 (fun v1 v2 v3 -> + let stream = decode_stream v1 in + let backlog = decode_optional (fun v -> decode_int v) v3 in + Stream.listen ?backlog stream (encode_unit_callback v2); + vnull + ); + "accept", vfun2 (fun v1 v2 -> + let server = decode_stream v1 + and client = decode_stream v2 in + encode_unit_result (Stream.accept server client) + ); + "readStart", vfun3 (fun v1 v2 v3 -> + let stream = decode_stream v1 + and callback = encode_callback encode_buffer v2 + and allocate = + decode_optional (fun v -> + let cb = prepare_callback v 1 in + (fun i -> decode_buffer (cb [vint i])) + ) v3 + in + Stream.read_start ?allocate stream callback; + vnull + ); + "readStop", vfun1 (fun v -> + let stream = decode_stream v in + encode_unit_result (Stream.read_stop stream) + ); + "write", vfun3 (fun v1 v2 v3 -> + let stream = decode_stream v1 + and data = decode_buffers v2 + and callback = + let cb = prepare_callback v3 2 in + (fun result bytes_written -> + ignore(cb [encode_unit_result result; vint bytes_written]) + ) + in + Stream.write stream data callback; + vnull + ); + "write2", vfun4 (fun v1 v2 v3 v4 -> + let stream = decode_pipe v1 + and data = decode_buffers v2 + and callback = + let cb = prepare_callback v4 2 in + (fun result bytes_written -> + ignore(cb [encode_unit_result result; vint bytes_written]) + ) + in + (match decode_enum v3 with + | 0,[vh] -> Stream.write2 stream data ~send_handle:(decode_tcp vh) callback + | 1,[vh] -> Stream.write2 stream data ~send_handle:(decode_pipe vh) callback + | _ -> unexpected_value v3 "eval.luv.Stream.SendHandle" + ); + vnull + ); + "tryWrite", vfun2 (fun v1 v2 -> + let stream = decode_stream v1 + and data = decode_buffers v2 in + encode_result vint (Stream.try_write stream data) + ); + "isReadable", vfun1 (fun v -> + let stream = decode_stream v in + vbool (Stream.is_readable stream) + ); + "isWritable", vfun1 (fun v -> + let stream = decode_stream v in + vbool (Stream.is_writable stream) + ); + "setBlocking", vfun2 (fun v1 v2 -> + let stream = decode_stream v1 + and block = decode_bool v2 in + encode_unit_result (Stream.set_blocking stream block) + ); +] + +let signum_fields = [ + "SIGABRT", vint Signal.sigabrt; + "SIGFPE", vint Signal.sigfpe; + "SIGHUP", vint Signal.sighup; + "SIGILL", vint Signal.sigill; + "SIGINT", vint Signal.sigint; + "SIGKILL", vint Signal.sigkill; + "SIGSEGV", vint Signal.sigsegv; + "SIGTERM", vint Signal.sigterm; + "SIGWINCH", vint Signal.sigwinch; +] + +let signal_fields = [ + "init", vfun1 (fun v -> + let loop = decode_loop v in + encode_result (fun s -> VHandle (HSignal s)) (Signal.init ~loop ()) + ); + "start", vfun3 (fun v1 v2 v3 -> + let s = decode_signal v1 + and signum = decode_int v2 + and cb = prepare_callback v3 0 in + encode_unit_result (Signal.start s signum (fun() -> ignore(cb []))) + ); + "startOneshot", vfun3 (fun v1 v2 v3 -> + let s = decode_signal v1 + and signum = decode_int v2 + and cb = prepare_callback v3 0 in + encode_unit_result (Signal.start_oneshot s signum (fun() -> ignore(cb []))) + ); + "stop", vfun1 (fun v -> + let s = decode_signal v in + encode_unit_result (Signal.stop s) + ); + "signum", vfun1 (fun v -> + let s = decode_signal v in + vint (Signal.signum s) + ); +] + +let process_fields = [ + "stdin", vint Process.stdin; + "stdout", vint Process.stdout; + "stderr", vint Process.stderr; + "toParentPipe", vfun5 (fun v1 v2 v3 v4 v5 -> + let fd = decode_int v1 + and parent_pipe = decode_pipe v2 + and readable_in_child = decode_bool v3 + and writable_in_child = decode_bool v4 + and overlapped = decode_bool v5 in + let r = Process.to_parent_pipe ~fd ~parent_pipe ~readable_in_child ~writable_in_child ~overlapped () in + VHandle (HRedirection r) + ); + "inheritFd", vfun2 (fun v1 v2 -> + let fd = decode_int v1 + and from_parent_fd = decode_int v2 in + let r = Process.inherit_fd ~fd ~from_parent_fd () in + VHandle (HRedirection r) + ); + "inheritStream", vfun2 (fun v1 v2 -> + let fd = decode_int v1 + and from_parent_stream = decode_stream v2 in + let r = Process.inherit_stream ~fd ~from_parent_stream () in + VHandle (HRedirection r) + ); + "spawn", vfun4 (fun v1 v2 v3 v4 -> + let loop = decode_loop v1 + and cmd = decode_native_string v2 + and args = List.map decode_native_string (decode_array v3) in + let result = + if v4 = VNull then + Process.spawn ~loop cmd args + else begin + let options = decode_object v4 in + let get name_hash f = + let v = object_field options name_hash in + decode_optional f v + in + let on_exit = + get key_onExit (fun v -> + let cb = prepare_callback v 3 in + (fun p ~exit_status ~term_signal -> + ignore(cb [VHandle (HProcess p); VInt64 exit_status; vint term_signal]) + ) + ) + and environment = + get key_environment (fun v -> + match decode_instance v with + | { ikind = IStringMap m } -> + StringHashtbl.fold (fun k (_,v) acc -> (k, decode_native_string v) :: acc) m [] + | _ -> + unexpected_value v "haxe.ds.Map" + ) + and redirect = + get key_redirect (fun v -> + List.map (fun v2 -> + match v2 with + | VHandle (HRedirection r) -> r + | _ -> unexpected_value v2 "eval.luv.Process.Redirection" + ) (decode_array v) + ) + and working_directory = get key_workingDirectory decode_native_string + and uid = get key_uid decode_int + and gid = get key_gid decode_int + and windows_verbatim_arguments = get key_windowsVerbatimArguments decode_bool + and detached = get key_detached decode_bool + and windows_hide = get key_windowsHide decode_bool + and windows_hide_console = get key_windowsHideConsole decode_bool + and windows_hide_gui = get key_windowsHideGui decode_bool + in + (* Process.spawn ~loop ?detached cmd args *) + Process.spawn ~loop ?on_exit ?environment ?working_directory ?redirect + ?uid ?gid ?windows_verbatim_arguments ?detached ?windows_hide + ?windows_hide_console ?windows_hide_gui cmd args + end + in + encode_result (fun p -> VHandle (HProcess p)) result + ); + "disableStdioInheritance", vfun0 (fun() -> + Process.disable_stdio_inheritance(); + vnull + ); + "killPid", vfun2 (fun v1 v2 -> + let pid = decode_int v1 + and sig_num = decode_int v2 in + encode_unit_result (Process.kill_pid ~pid sig_num) + ); + "pid", vfun1 (fun v -> + let p = decode_process v in + vint (Process.pid p) + ); +] + +let request_fields = [ + "cancel", vfun1 (fun v -> + encode_unit_result (match v with + | VHandle (HFileRequest r) -> Request.cancel r + | VHandle (HAddrRequest r) -> Request.cancel r + | VHandle (HNameRequest r) -> Request.cancel r + | VHandle (HRandomRequest r) -> Request.cancel r + | VHandle (HThreadPoolRequest r) -> Request.cancel r + | _ -> unexpected_value v "eval.luv.Request" + ) + ) +] + +let dns_fields = [ + "createAddrRequest", vfun0 (fun () -> + VHandle (HAddrRequest (DNS.Addr_info.Request.make())) + ); + "createInfoRequest", vfun0 (fun () -> + VHandle (HNameRequest (DNS.Name_info.Request.make())) + ); + "getAddrInfo", vfun5 (fun v1 v2 v3 v4 v5 -> + let loop = decode_loop v1 + and node = decode_optional decode_string v2 + and service = decode_optional decode_string v3 + in + if node = None && service = None then + throw (create_haxe_exception "Either node or service has to be not null") null_pos + else begin + let callback = + let cb = prepare_callback v5 1 in + (fun result -> + let v = + encode_result (fun infos -> + encode_array (List.map (fun (info:DNS.Addr_info.t) -> + let fields = [ + key_family,encode_address_family info.family; + key_sockType,encode_socket_type info.socktype; + key_protocol,vint info.protocol; + key_addr,encode_sockaddr info.addr; + ] in + let fields = + match info.canonname with + | None -> fields + | Some s -> (key_canonName,EvalString.create_unknown s) :: fields + in + encode_obj fields + ) infos) + ) result + in + ignore(cb [v]) + ) + in + if v4 = VNull then + DNS.getaddrinfo ~loop ?node ?service () callback + else begin + let options = decode_object v4 in + let get name_hash f = + let v = object_field options name_hash in + decode_optional f v + in + let request = + get key_request (function + | VHandle (HAddrRequest r) -> r + | v -> unexpected_value v "eval.luv.Dns.AddrInfoRequest" + ) + and family = get key_family decode_address_family + and socktype = get key_sockType decode_socket_type + and protocol = get key_protocol decode_int + and flags = + get key_flags (fun v -> + List.map (fun v -> + match decode_int v with + | 0 -> `PASSIVE + | 1 -> `CANONNAME + | 2 -> `NUMERICHOST + | 3 -> `NUMERICSERV + | 4 -> `V4MAPPED + | 5 -> `ALL + | 6 -> `ADDRCONFIG + | _ -> unexpected_value v "eval.luv.Dns.AddrInfoFlag" + ) (decode_array v) + ) + in + DNS.getaddrinfo ~loop ?request ?family ?socktype ?protocol ?flags ?service ?node () callback + end; + vnull + end + ); + "getNameInfo", vfun4 (fun v1 v2 v3 v4 -> + let loop = decode_loop v1 + and addr = decode_sockaddr v2 + and callback = + let cb = prepare_callback v4 1 in + (fun result -> + let v = + encode_result (fun (node,service) -> + encode_obj [ + key_node,encode_string node; + key_service,encode_string service; + ] + ) result + in + ignore(cb [v]) + ) + in + if v3 = VNull then + DNS.getnameinfo ~loop addr callback + else begin + let options = decode_object v3 in + let get name_hash f = + let v = object_field options name_hash in + decode_optional f v + in + let request = + get key_request (function + | VHandle (HNameRequest r) -> r + | v -> unexpected_value v "eval.luv.Dns.NameInfoRequest" + ) + and flags = + get key_flags (fun v -> + List.map (fun v -> + match decode_int v with + | 0 -> `NAMEREQD + | 1 -> `DGRAM + | 2 -> `NOFQDN + | 3 -> `NUMERICHOST + | 4 -> `NUMERICSERV + | _ -> unexpected_value v "eval.luv.Dns.NameInfoFlag" + ) (decode_array v) + ) + in + DNS.getnameinfo ~loop ?request ?flags addr callback + end; + vnull + ); +] + +module F = struct + let async ~vloop ~vrequest fn = + let loop = Some (decode_loop vloop) + and request = decode_optional decode_file_request vrequest in + fn ?loop ?request + + let path ~vpath fn = + fn (decode_native_string vpath) + + let file ~vfile fn = + fn (decode_file vfile) + + let dir ~vdir fn = + fn (decode_dir vdir) + + let to_ ~vto fn = + let to_ = decode_native_string vto in + fn ~to_ + + let mode ~vmode fn = + fn (decode_file_mode_list vmode) + + let mode_opt ~vmode fn = + let mode = decode_optional decode_file_mode_list vmode in + fn ?mode + + let open_ ~vmode ~vpath ~vflags fn = + let flags = List.map decode_file_open_flag (decode_array vflags) in + (fn |> mode_opt ~vmode |> path ~vpath) flags + + let rename ~vpath ~vto fn = + fn |> path ~vpath |> to_ ~vto + + let mkdir ~vmode ~vpath fn = + fn |> mode_opt ~vmode |> path ~vpath + + let data ~vfile_offset ~vfile ~vbuffers fn = + let file = decode_file vfile + and file_offset = Some (decode_i64 vfile_offset) + and buffers = decode_buffers vbuffers in + fn ?file_offset file buffers + + let ftruncate ~vfile ~vlength fn = + let file = decode_file vfile + and length = decode_i64 vlength in + fn file length + + let copyFile ~vflags ~vpath ~vto fn = + let flags = decode_int_flags vflags in + let excl = if List.mem 0 flags then Some true else None + and ficlone = if List.mem 1 flags then Some true else None + and ficlone_force = if List.mem 2 flags then Some true else None in + (fn ?excl ?ficlone ?ficlone_force) |> path ~vpath |> to_ ~vto + + let sendFile ~vfile ~vto ~voffset ~vlength fn = + let to_ = decode_file vto + and offset = decode_i64 voffset + and length = decode_size_t vlength in + (fn |> file ~vfile) ~to_ ~offset length + + let access ~vpath ~vflags fn = + let flags = + List.map (fun v -> + match decode_int v with + | 0 -> `F_OK + | 1 -> `R_OK + | 2 -> `W_OK + | 3 -> `X_OK + | _ -> unexpected_value v "eval.luv.File.FileAccessFlag" + ) (decode_array vflags) in + (fn |> path ~vpath) flags + + let utime ~vatime ~vmtime fn = + let atime = num vatime + and mtime = num vmtime in + fn ~atime ~mtime + + let link ~vlink fn = + let link = decode_native_string vlink in + fn ~link + + let symlink ~vflags fn = + let flags = decode_int_flags vflags in + let dir = if List.mem 0 flags then Some true else None + and junction = if List.mem 1 flags then Some true else None in + fn ?dir ?junction + + let chown ~vuid ~vgid fn = + let uid = decode_int vuid + and gid = decode_int vgid in + fn ~uid ~gid + + let readdir ~vdir ~vnumber_of_entries fn = + let number_of_entries = decode_optional decode_int vnumber_of_entries in + fn ?number_of_entries |> dir ~vdir +end + +let file_fields = [ + "get_stdin", VHandle (HFile File.stdin); + "get_stdout", VHandle (HFile File.stdout); + "get_stderr", VHandle (HFile File.stderr); + "createRequest", vfun0 (fun() -> + VHandle (HFileRequest (File.Request.make())) + ); + "testMode", vfun2 (fun v1 v2 -> + let mask = decode_file_mode_list v1 + and bits = + match v2 with + | VHandle (HFileModeNumeric m) -> m + | _ -> unexpected_value v2 "eval.luv.File.FileModeNumeric" + in + vbool (File.Mode.test mask bits) + ); + "open", vfun6 (fun vloop vpath vflags vmode vrequest vcallback -> + let callback = encode_callback (fun f -> VHandle (HFile f)) vcallback in + (File.open_ |> F.async ~vloop ~vrequest |> F.open_ ~vmode ~vpath ~vflags) callback; + vnull + ); + "close", vfun4 (fun vfile vloop vrequest vcallback -> + let callback = encode_unit_callback vcallback in + (File.close |> F.async ~vloop ~vrequest |> F.file ~vfile) callback; + vnull + ); + "read", vfun6 (fun vfile vloop vfile_offset vbuffers vrequest vcallback -> + let callback = encode_callback encode_size_t vcallback in + (File.read |> F.async ~vloop ~vrequest |> F.data ~vfile_offset ~vfile ~vbuffers) callback; + vnull + ); + "write", vfun6 (fun vfile vloop vfile_offset vbuffers vrequest vcallback -> + let callback = encode_callback encode_size_t vcallback in + (File.write |> F.async ~vloop ~vrequest |> F.data ~vfile_offset ~vfile ~vbuffers) callback; + vnull + ); + "unlink", vfun4 (fun vloop vpath vrequest vcallback -> + let callback = encode_unit_callback vcallback in + (File.unlink |> F.async ~vloop ~vrequest |> F.path ~vpath) callback; + vnull + ); + "rename", vfun5 (fun vloop vpath vto vrequest vcallback -> + let callback = encode_unit_callback vcallback in + (File.rename |> F.async ~vloop ~vrequest |> F.rename ~vpath ~vto) callback; + vnull + ); + "mkstemp", vfun4 (fun vloop vpath vrequest vcallback -> + let callback = + encode_callback (fun (n,file) -> + encode_obj [key_name,vnative_string n; key_file,VHandle (HFile file)] + ) vcallback + in + (File.mkstemp |> F.async ~vloop ~vrequest |> F.path ~vpath) callback; + vnull + ); + "mkdtemp", vfun4 (fun vloop vpath vrequest vcallback -> + let callback = encode_callback vnative_string vcallback in + (File.mkdtemp |> F.async ~vloop ~vrequest |> F.path ~vpath) callback; + vnull + ); + "mkdir", vfun5 (fun vloop vpath vmode vrequest vcallback -> + let callback = encode_unit_callback vcallback in + (File.mkdir |> F.async ~vloop ~vrequest |> F.mkdir ~vmode ~vpath) callback; + vnull + ); + "rmdir", vfun4 (fun vloop vpath vrequest vcallback -> + let callback = encode_unit_callback vcallback in + (File.rmdir |> F.async ~vloop ~vrequest |> F.path ~vpath) callback; + vnull + ); + "stat", vfun4 (fun vloop vpath vrequest vcallback -> + let callback = encode_callback encode_file_stat vcallback in + (File.stat |> F.async ~vloop ~vrequest |> F.path ~vpath) callback; + vnull + ); + "lstat", vfun4 (fun vloop vpath vrequest vcallback -> + let callback = encode_callback encode_file_stat vcallback in + (File.lstat |> F.async ~vloop ~vrequest |> F.path ~vpath) callback; + vnull + ); + "fstat", vfun4 (fun vfile vloop vrequest vcallback -> + let callback = encode_callback encode_file_stat vcallback in + (File.fstat |> F.async ~vloop ~vrequest |> F.file ~vfile) callback; + vnull + ); + "statFs", vfun4 (fun vloop vpath vrequest vcallback -> + let callback = encode_callback encode_file_statfs vcallback in + (File.statfs |> F.async ~vloop ~vrequest |> F.path ~vpath) callback; + vnull + ); + "fsync", vfun4 (fun vfile vloop vrequest vcallback -> + let callback = encode_unit_callback vcallback in + (File.fsync |> F.async ~vloop ~vrequest |> F.file ~vfile) callback; + vnull + ); + "fdataSync", vfun4 (fun vfile vloop vrequest vcallback -> + let callback = encode_unit_callback vcallback in + (File.fdatasync |> F.async ~vloop ~vrequest |> F.file ~vfile) callback; + vnull + ); + "ftruncate", vfun5 (fun vfile vloop vlength vrequest vcallback -> + let callback = encode_unit_callback vcallback in + (File.ftruncate |> F.async ~vloop ~vrequest |> F.ftruncate ~vfile ~vlength) callback; + vnull + ); + "copyFile", vfun6 (fun vloop vpath vto vflags vrequest vcallback -> + let callback = encode_unit_callback vcallback in + (File.copyfile |> F.async ~vloop ~vrequest |> F.copyFile ~vflags ~vpath ~vto) callback; + vnull + ); + "sendFile", vfun7 (fun vfile vloop vto voffset vlength vrequest vcallback -> + let callback = encode_callback encode_size_t vcallback in + (File.sendfile |> F.async ~vloop ~vrequest |> F.sendFile ~vfile ~vto ~voffset ~vlength) callback; + vnull + ); + "access", vfun5 (fun vloop vpath vflags vrequest vcallback -> + let callback = encode_unit_callback vcallback in + (File.access |> F.async ~vloop ~vrequest |> F.access ~vpath ~vflags) callback; + vnull + ); + "chmod", vfun5 (fun vloop vpath vmode vrequest vcallback -> + let callback = encode_unit_callback vcallback in + (File.chmod |> F.async ~vloop ~vrequest |> F.path ~vpath |> F.mode ~vmode) callback; + vnull + ); + "fchmod", vfun5 (fun vfile vloop vmode vrequest vcallback -> + let callback = encode_unit_callback vcallback in + (File.fchmod |> F.async ~vloop ~vrequest |> F.file ~vfile |> F.mode ~vmode) callback; + vnull + ); + "utime", vfun6 (fun vloop vpath vatime vmtime vrequest vcallback -> + let callback = encode_unit_callback vcallback in + (File.utime |> F.async ~vloop ~vrequest |> F.path ~vpath |> F.utime ~vatime ~vmtime) callback; + vnull + ); + "lutime", vfun6 (fun vloop vpath vatime vmtime vrequest vcallback -> + let callback = encode_unit_callback vcallback in + (File.lutime |> F.async ~vloop ~vrequest |> F.path ~vpath |> F.utime ~vatime ~vmtime) callback; + vnull + ); + "futime", vfun6 (fun vfile vloop vatime vmtime vrequest vcallback -> + let callback = encode_unit_callback vcallback in + (File.futime |> F.async ~vloop ~vrequest |> F.file ~vfile |> F.utime ~vatime ~vmtime) callback; + vnull + ); + "link", vfun5 (fun vloop vpath vlink vrequest vcallback -> + let callback = encode_unit_callback vcallback in + (File.link |> F.async ~vloop ~vrequest |> F.path ~vpath |> F.link ~vlink) callback; + vnull + ); + "symlink", vfun6 (fun vloop vpath vlink vflags vrequest vcallback -> + let callback = encode_unit_callback vcallback in + (File.symlink |> F.async ~vloop ~vrequest |> F.symlink ~vflags |> F.path ~vpath |> F.link ~vlink) callback; + vnull + ); + "readLink", vfun4 (fun vloop vpath vrequest v4 -> + let callback = encode_callback vnative_string v4 in + (File.readlink |> F.async ~vloop ~vrequest |> F.path ~vpath) callback; + vnull + ); + "realPath", vfun4 (fun vloop vpath vrequest v4 -> + let callback = encode_callback vnative_string v4 in + (File.realpath |> F.async ~vloop ~vrequest |> F.path ~vpath) callback; + vnull + ); + "chown", vfun6 (fun vloop vpath vuid vgid vrequest vcallback -> + let callback = encode_unit_callback vcallback in + (File.chown |> F.async ~vloop ~vrequest |> F.path ~vpath |> F.chown ~vuid ~vgid) callback; + vnull + ); + "lchown", vfun6 (fun vloop vpath vuid vgid vrequest vcallback -> + let callback = encode_unit_callback vcallback in + (File.lchown |> F.async ~vloop ~vrequest |> F.path ~vpath |> F.chown ~vuid ~vgid) callback; + vnull + ); + "fchown", vfun6 (fun vfile vloop vuid vgid vrequest vcallback -> + let callback = encode_unit_callback vcallback in + (File.fchown |> F.async ~vloop ~vrequest |> F.file ~vfile |> F.chown ~vuid ~vgid) callback; + vnull + ); + "toInt", vfun1 (fun v -> + let file = decode_file v in + vint (File.to_int file) + ); +] + +let file_sync_fields = [ + "open", vfun3 (fun vpath vflags vmode -> + File.Sync.open_ |> F.open_ ~vmode ~vpath ~vflags |> encode_result (fun f -> VHandle (HFile f)) + ); + "close", vfun1 (fun vfile -> + File.Sync.close |> F.file ~vfile |> encode_unit_result + ); + "read", vfun3 (fun vfile vfile_offset vbuffers -> + File.Sync.read |> F.data ~vfile_offset ~vfile ~vbuffers |> encode_result encode_size_t + ); + "write", vfun3 (fun vfile vfile_offset vbuffers -> + File.Sync.write |> F.data ~vfile_offset ~vfile ~vbuffers |> encode_result encode_size_t + ); + "unlink", vfun1 (fun vpath -> + File.Sync.unlink |> F.path ~vpath |> encode_unit_result + ); + "rename", vfun2 (fun vpath vto -> + File.Sync.rename |> F.rename ~vpath ~vto |> encode_unit_result + ); + "mkstemp", vfun1 (fun vpath -> + let encode (n,file) = + encode_obj [key_name,vnative_string n; key_file,VHandle (HFile file)] + in + File.Sync.mkstemp |> F.path ~vpath |> encode_result encode + ); + "mkdtemp", vfun1 (fun vpath -> + File.Sync.mkdtemp |> F.path ~vpath |> encode_result vnative_string + ); + "mkdir", vfun2 (fun vpath vmode -> + File.Sync.mkdir |> F.mkdir ~vmode ~vpath |> encode_unit_result + ); + "rmdir", vfun1 (fun vpath -> + File.Sync.rmdir |> F.path ~vpath |> encode_unit_result + ); + "stat", vfun1 (fun vpath -> + File.Sync.stat |> F.path ~vpath |> encode_result encode_file_stat + ); + "lstat", vfun1 (fun vpath -> + File.Sync.lstat |> F.path ~vpath |> encode_result encode_file_stat + ); + "fstat", vfun1 (fun vfile -> + File.Sync.fstat |> F.file ~vfile |> encode_result encode_file_stat + ); + "statFs", vfun1 (fun vpath -> + File.Sync.statfs |> F.path ~vpath |> encode_result encode_file_statfs + ); + "fsync", vfun1 (fun vfile -> + File.Sync.fsync |> F.file ~vfile |> encode_unit_result + ); + "fdataSync", vfun1 (fun vfile -> + File.Sync.fdatasync |> F.file ~vfile |> encode_unit_result + ); + "ftruncate", vfun2 (fun vfile vlength -> + File.Sync.ftruncate |> F.ftruncate ~vfile ~vlength |> encode_unit_result + ); + "copyFile", vfun3 (fun vpath vto vflags -> + File.Sync.copyfile |> F.copyFile ~vflags ~vpath ~vto |> encode_unit_result + ); + "sendFile", vfun4 (fun vfile vto voffset vlength -> + File.Sync.sendfile |> F.sendFile ~vfile ~vto ~voffset ~vlength |> encode_result encode_size_t + ); + "access", vfun2 (fun vpath vflags -> + File.Sync.access |> F.access ~vpath ~vflags |> encode_unit_result + ); + "chmod", vfun2 (fun vpath vmode -> + File.Sync.chmod |> F.path ~vpath |> F.mode ~vmode |> encode_unit_result + ); + "fchmod", vfun2 (fun vfile vmode -> + File.Sync.fchmod |> F.file ~vfile |> F.mode ~vmode |> encode_unit_result + ); + "utime", vfun3 (fun vpath vatime vmtime -> + File.Sync.utime |> F.path ~vpath |> F.utime ~vatime ~vmtime |> encode_unit_result + ); + "lutime", vfun3 (fun vpath vatime vmtime -> + File.Sync.lutime |> F.path ~vpath |> F.utime ~vatime ~vmtime |> encode_unit_result + ); + "futime", vfun3 (fun vfile vatime vmtime -> + File.Sync.futime |> F.file ~vfile |> F.utime ~vatime ~vmtime |> encode_unit_result + ); + "link", vfun2 (fun vpath vlink -> + File.Sync.link |> F.path ~vpath |> F.link ~vlink |> encode_unit_result + ); + "symlink", vfun3 (fun vpath vlink vflags -> + File.Sync.symlink |> F.symlink ~vflags |> F.path ~vpath |> F.link ~vlink |> encode_unit_result + ); + "readLink", vfun1 (fun vpath -> + File.Sync.readlink |> F.path ~vpath |> encode_result vnative_string + ); + "realPath", vfun1 (fun vpath -> + File.Sync.realpath |> F.path ~vpath |> encode_result vnative_string + ); + "chown", vfun3 (fun vpath vuid vgid -> + File.Sync.chown |> F.path ~vpath |> F.chown ~vuid ~vgid |> encode_unit_result + ); + "lchown", vfun3 (fun vpath vuid vgid -> + File.Sync.lchown |> F.path ~vpath |> F.chown ~vuid ~vgid |> encode_unit_result + ); + "fchown", vfun3 (fun vfile vuid vgid -> + File.Sync.fchown |> F.file ~vfile |> F.chown ~vuid ~vgid |> encode_unit_result + ); +] + +let dir_fields = [ + "open", vfun4 (fun vloop vpath vrequest vcallback -> + let callback = encode_callback (fun dir -> VHandle (HDir dir)) vcallback in + (File.opendir |> F.async ~vloop ~vrequest |> F.path ~vpath) callback; + vnull + ); + "close", vfun4 (fun vdir vloop vrequest vcallback -> + let callback = encode_unit_callback vcallback in + (File.closedir |> F.async ~vloop ~vrequest |> F.dir ~vdir) callback; + vnull + ); + "read", vfun5 (fun vdir vloop vnumber_of_entries vrequest vcallback -> + let callback = + encode_callback (fun a -> + encode_array_a (Array.map encode_dirent a) + ) vcallback + in + (File.readdir |> F.async ~vloop ~vrequest |> F.readdir ~vnumber_of_entries ~vdir) callback; + vnull + ); + "scan", vfun4 (fun vloop vpath vrequest vcallback -> + let callback = encode_callback encode_scandir vcallback in + (File.scandir |> F.async ~vloop ~vrequest |> F.path ~vpath) callback; + vnull + ); +] + +let dir_sync_fields = [ + "open", vfun1 (fun vpath -> + File.Sync.opendir |> F.path ~vpath |> encode_result (fun dir -> VHandle (HDir dir)) + ); + "close", vfun1 (fun vdir -> + File.Sync.closedir |> F.dir ~vdir |> encode_unit_result + ); + "read", vfun2 (fun vdir vnumber_of_entries -> + let encode a = + encode_array_a (Array.map encode_dirent a) + in + File.Sync.readdir |> F.readdir ~vnumber_of_entries ~vdir |> encode_result encode + ); + "scan", vfun1 (fun vpath -> + File.Sync.scandir |> F.path ~vpath |> encode_result encode_scandir + ); +] + +let fs_event_fields = [ + "init", vfun1 (fun v -> + let loop = decode_loop v in + encode_result (fun e -> VHandle (HFsEvent e)) (FS_event.init ~loop ()) + ); + "start", vfun4 (fun v1 v2 v3 v4 -> + let event = decode_fs_event v1 + and path = decode_native_string v2 + and callback = + encode_callback (fun (file,events) -> + let vevents = + List.map (fun (e:FS_event.Event.t) -> + match e with + | `RENAME -> vint 0 + | `CHANGE -> vint 1 + ) events + in + encode_obj [ + key_file,vnative_string file; + key_events,encode_array vevents; + ] + ) v4 + in + if v3 = VNull then + FS_event.start event path callback + else begin + let flags = decode_int_flags v3 in + let watch_entry = List.mem 0 flags + and stat = List.mem 1 flags + and recursive = List.mem 2 flags in + FS_event.start ~watch_entry ~stat ~recursive event path callback + end; + vnull + ); + "stop", vfun1 (fun v -> + let event = decode_fs_event v in + encode_unit_result (FS_event.stop event) + ); +] + +let thread_pool_fields = [ + "createRequest", vfun0 (fun() -> + VHandle (HThreadPoolRequest (Thread_pool.Request.make())) + ); + "queueWork", vfun4 (fun v1 v2 v3 v4 -> + let loop = decode_loop v1 + and request = + decode_optional (function + | VHandle (HThreadPoolRequest r) -> r + | v -> unexpected_value v "eval.luv.ThreadPool.ThreadPoolRequest" + ) v2 + and work = + let cb = prepare_callback v3 0 in + (fun() -> EvalThread.run (get_ctx()) (fun() -> cb [])) + and callback = encode_unit_callback v4 in + Thread_pool.queue_work ~loop ?request work callback; + vnull + ); + "setSize", vfun2 (fun v1 v2 -> + let size = decode_int v1 + and if_not_already_set = decode_optional decode_bool v2 in + Thread_pool.set_size ?if_not_already_set size; + vnull + ); +] + +let thread_fields = [ + "self", vfun0 (fun() -> + VHandle (HThread (Thread.self())) + ); + "create", vfun2 (fun v1 v2 -> + let fn = + let cb = prepare_callback v1 0 in + (fun() -> EvalThread.run (get_ctx()) (fun() -> cb [])) + and stack_size = decode_optional decode_int v2 in + encode_result (fun t -> VHandle (HThread t)) (Thread.create ?stack_size fn) + ); + "join", vfun1 (fun v -> + let thread = + match v with + | VHandle (HThread t) -> t + | _ -> unexpected_value v "eval.luv.Thread" + in + encode_unit_result (Thread.join thread) + ); +] + +let once_fields = [ + "init", vfun0 (fun() -> + encode_result (fun o -> VHandle (HOnce o)) (Once.init()) + ); + "once", vfun2 (fun v1 v2 -> + let once = + match v1 with + | VHandle (HOnce o) -> o + | _ -> unexpected_value v1 "eval.luv.Once" + and callback = prepare_callback v2 0 in + Once.once once (fun() -> ignore(callback [])); + vnull + ); +] + +let mutex_fields = [ + "init", vfun1 (fun v -> + let recursive = decode_optional decode_bool v in + encode_result (fun m -> VHandle (HMutex m)) (Mutex.init ?recursive ()) + ); + "destroy", vfun1 (fun v -> + Mutex.destroy (decode_mutex v); + vnull + ); + "lock", vfun1 (fun v -> + Mutex.lock (decode_mutex v); + vnull + ); + "tryLock", vfun1 (fun v -> + encode_unit_result (Mutex.trylock (decode_mutex v)) + ); + "unlock", vfun1 (fun v -> + Mutex.unlock (decode_mutex v); + vnull + ); +] + +let rwlock_fields = [ + "init", vfun0 (fun() -> + encode_result (fun l -> VHandle (HRwLock l)) (Rwlock.init()) + ); + "destroy", vfun1 (fun v -> + Rwlock.destroy (decode_rwlock v); + vnull + ); + "rdLock", vfun1 (fun v -> + Rwlock.rdlock (decode_rwlock v); + vnull + ); + "rdTryLock", vfun1 (fun v -> + encode_unit_result (Rwlock.tryrdlock (decode_rwlock v)) + ); + "rdUnlock", vfun1 (fun v -> + Rwlock.rdunlock (decode_rwlock v); + vnull + ); + "wrLock", vfun1 (fun v -> + Rwlock.wrlock (decode_rwlock v); + vnull + ); + "wrTryLock", vfun1 (fun v -> + encode_unit_result (Rwlock.trywrlock (decode_rwlock v)) + ); + "wrUnlock", vfun1 (fun v -> + Rwlock.wrunlock (decode_rwlock v); + vnull + ); +] + +let semaphore_fields = [ + "init", vfun1 (fun v -> + encode_result (fun s -> VHandle (HSemaphore s)) (Semaphore.init (decode_int v)) + ); + "destroy", vfun1 (fun v -> + Semaphore.destroy (decode_semaphore v); + vnull + ); + "post", vfun1 (fun v -> + Semaphore.post (decode_semaphore v); + vnull + ); + "wait", vfun1 (fun v -> + Semaphore.wait (decode_semaphore v); + vnull + ); + "tryWait", vfun1 (fun v -> + encode_unit_result (Semaphore.trywait (decode_semaphore v)) + ); +] + +let condition_fields = [ + "init", vfun0 (fun() -> + encode_result (fun s -> VHandle (HCondition s)) (Condition.init ()) + ); + "destroy", vfun1 (fun v -> + Condition.destroy (decode_condition v); + vnull + ); + "signal", vfun1 (fun v -> + Condition.signal (decode_condition v); + vnull + ); + "broadcast", vfun1 (fun v -> + Condition.broadcast (decode_condition v); + vnull + ); + "wait", vfun2 (fun v1 v2 -> + let condition = decode_condition v1 + and mutex = decode_mutex v2 in + Condition.wait condition mutex; + vnull + ); + "timedWait", vfun3 (fun v1 v2 v3 -> + let condition = decode_condition v1 + and mutex = decode_mutex v2 + and timeout = decode_int v3 in + encode_unit_result (Condition.timedwait condition mutex timeout) + ); +] + +let barrier_fields = [ + "init", vfun1 (fun v -> + encode_result (fun b -> VHandle (HBarrier b)) (Barrier.init (decode_int v)) + ); + "destroy", vfun1 (fun v -> + Barrier.destroy (decode_barrier v); + vnull + ); + "wait", vfun1 (fun v -> + vbool (Barrier.wait (decode_barrier v)) + ); +] + +let env_fields = [ + "getEnv", vfun1 (fun v -> + let name = decode_string v in + encode_result vnative_string (Env.getenv name) + ); + "setEnv", vfun2 (fun v1 v2 -> + let name = decode_string v1 + and value = decode_native_string v2 in + encode_unit_result (Env.setenv name ~value) + ); + "environ", vfun0 (fun() -> + let encode env = + let map = + List.fold_left (fun map (name,value) -> + StringHashtbl.add map (EvalString.create_unknown_vstring name) (vnative_string value); + map + ) (StringHashtbl.create()) env + in + encode_string_map_direct map + in + encode_result encode (Env.environ()) + ); +] + +let time_fields = [ + "getTimeOfDay", vfun0 (fun() -> + encode_result (fun (t:Time.t) -> + encode_obj [key_sec,VInt64 t.tv_sec; key_usec,vint32 t.tv_usec] + ) (Time.gettimeofday()) + ); + "hrTime", vfun0 (fun() -> + VUInt64 (Time.hrtime()) + ); + "sleep", vfun1 (fun v -> + Time.sleep (decode_int v); + vnull + ); +] + +let path_fields = [ + "exePath", vfun0 (fun() -> + encode_result vnative_string (Path.exepath()) + ); + "cwd", vfun0 (fun() -> + encode_result vnative_string (Path.cwd()) + ); + "chdir", vfun1 (fun v -> + encode_unit_result (Path.chdir (decode_native_string v)) + ); + "homedir", vfun0 (fun() -> + encode_result vnative_string (Path.homedir()) + ); + "tmpdir", vfun0 (fun() -> + encode_result vnative_string (Path.tmpdir()) + ); +] + +let random_fields = [ + "createRequest", vfun0 (fun() -> + VHandle (HRandomRequest (Random.Request.make())) + ); + "random", vfun4 (fun v1 v2 v3 v4 -> + let loop = decode_loop v1 + and buffer = decode_buffer v2 + and request = + decode_optional (function + | VHandle (HRandomRequest r) -> r + | v -> unexpected_value v "eval.luv.Random.RandomRequest" + ) v3 + and callback = encode_unit_callback v4 in + Random.random ~loop ?request buffer callback; + vnull + ); +] + +let random_sync_fields = [ + "random", vfun1(fun v -> + let buffer = decode_buffer v in + encode_unit_result (Random.Sync.random buffer) + ); +] + +let network_fields = [ + "interfaceAddresses", vfun0 (fun() -> + encode_result (fun addresses -> + encode_array (List.map (fun (a:Network.Interface_address.t) -> + encode_obj [ + key_name, encode_string a.name; + key_isInternal, vbool a.is_internal; + key_physical, vnative_string a.physical; + key_address, encode_sockaddr a.address; + key_netmask, encode_sockaddr a.netmask; + ] + ) addresses) + ) (Network.interface_addresses()) + ); + "ifIndexToName", vfun1 (fun v -> + let index = decode_int v in + encode_result encode_string (Network.if_indextoname index) + ); + "ifIndexToIid", vfun1 (fun v -> + let index = decode_int v in + encode_result encode_string (Network.if_indextoiid index) + ); + "getHostName", vfun0 (fun() -> + encode_result encode_string (Network.gethostname()) + ); +] + +let fs_poll_fields = [ + "init", vfun1 (fun v -> + let loop = decode_loop v in + encode_result (fun p -> VHandle (HFsPoll p)) (FS_poll.init ~loop ()) + ); + "start", vfun4 (fun v1 v2 v3 v4 -> + let poll = decode_fs_poll v1 + and path = decode_native_string v2 + and interval = decode_optional decode_int v3 + and callback = + encode_callback (fun (previous,current) -> + encode_obj [ + key_previous,encode_file_stat previous; + key_current,encode_file_stat current; + ] + ) v4 + in + FS_poll.start ?interval poll path callback; + vnull + ); + "stop", vfun1 (fun v -> + let poll = decode_fs_poll v in + encode_unit_result (FS_poll.stop poll) + ); +] + +let resource_fields = [ + "uptime", vfun0 (fun() -> + encode_result vfloat (Resource.uptime()); + ); + "loadAvg", vfun0 (fun() -> + let m1,m5,m15 = Resource.loadavg() in + encode_array_a [|vfloat m1; vfloat m5; vfloat m15|]; + ); + "freeMemory", vfun0 (fun() -> + VUInt64 (Resource.free_memory()) + ); + "totalMemory", vfun0 (fun() -> + VUInt64 (Resource.total_memory()) + ); + "constrainedMemory", vfun0 (fun() -> + encode_nullable (fun u -> VUInt64 u) (Resource.constrained_memory()) + ); + "getPriority", vfun1 (fun v -> + let pid = decode_int v in + encode_result vint (Resource.getpriority pid) + ); + "setPriority", vfun2 (fun v1 v2 -> + let pid = decode_int v1 + and priority = decode_int v2 in + encode_unit_result (Resource.setpriority pid priority) + ); + "residentSetMemory", vfun0 (fun() -> + encode_result encode_size_t (Resource.resident_set_memory()) + ); + "getRUsage", vfun0 (fun() -> + let encode_timeval (t:Resource.timeval) = + encode_obj [ + key_sec, VInt64 (Signed.Long.to_int64 t.sec); + key_usec, VInt64 (Signed.Long.to_int64 t.usec) + ] + in + let encode_rusage (r:Resource.rusage) = + encode_obj_s [ + "utime", encode_timeval r.utime; + "stime", encode_timeval r.stime; + "maxrss", VUInt64 r.maxrss; + "ixrss", VUInt64 r.ixrss; + "idrss", VUInt64 r.idrss; + "isrss", VUInt64 r.isrss; + "minflt", VUInt64 r.minflt; + "majflt", VUInt64 r.majflt; + "nswap", VUInt64 r.nswap; + "inblock", VUInt64 r.inblock; + "oublock", VUInt64 r.oublock; + "msgsnd", VUInt64 r.msgsnd; + "msgrcv", VUInt64 r.msgrcv; + "nsignals", VUInt64 r.nsignals; + "nvcsw", VUInt64 r.nvcsw; + "nivcsw", VUInt64 r.nivcsw; + ] + in + encode_result encode_rusage (Resource.getrusage()) + ); +] + +let system_info_fields = [ + "cpuInfo", vfun0 (fun() -> + let encode_info (i:System_info.CPU_info.t) = + encode_obj_s [ + "model", encode_string i.model; + "speed", vint i.speed; + "times", encode_obj_s [ + "user", VUInt64 i.times.user; + "nice", VUInt64 i.times.nice; + "sys", VUInt64 i.times.sys; + "idle", VUInt64 i.times.idle; + "irq", VUInt64 i.times.irq; + ] + ] + in + let encode l = + encode_array (List.map encode_info l) + in + encode_result encode (System_info.cpu_info()); + ); + "uname", vfun0 (fun() -> + encode_result (fun (u:System_info.Uname.t) -> + encode_obj_s [ + "sysname", encode_string u.sysname; + "release", encode_string u.release; + "version", encode_string u.version; + "machine", encode_string u.machine; + ] + ) (System_info.uname()) + ); +] + +let pid_fields = [ + "getPid", vfun0 (fun() -> + vint (Pid.getpid()) + ); + "getPPid", vfun0 (fun() -> + vint (Pid.getppid()) + ); +] + +let passwd_fields = [ + "getPasswd", vfun0 (fun() -> + encode_result (fun (p:Passwd.t) -> + encode_obj_s [ + "username",encode_string p.username; + "uid",vint p.uid; + "gid",vint p.gid; + "shell",encode_nullable encode_string p.shell; + "homedir",vnative_string p.homedir; + ] + ) (Passwd.get_passwd()) + ); +] + +let metrics_fields = [ + "idleTime", vfun1 (fun v -> + let loop = decode_loop v in + VUInt64 (Metrics.idle_time loop) + ); +] + +let prepare_fields = [ + "init", vfun1 (fun v -> + let loop = decode_loop v in + encode_result (fun i -> VHandle (HPrepare i)) (Prepare.init ~loop ()) + ); + "start", vfun2 (fun v1 v2 -> + let prepare = decode_prepare v1 in + let cb = prepare_callback v2 0 in + encode_unit_result (Prepare.start prepare (fun() -> ignore(cb []))); + ); + "stop", vfun1 (fun v -> + let prepare = decode_prepare v in + encode_unit_result (Prepare.stop prepare) + ); +] + +let check_fields = [ + "init", vfun1 (fun v -> + let loop = decode_loop v in + encode_result (fun i -> VHandle (HCheck i)) (Check.init ~loop ()) + ); + "start", vfun2 (fun v1 v2 -> + let check = decode_check v1 in + let cb = prepare_callback v2 0 in + encode_unit_result (Check.start check (fun() -> ignore(cb []))); + ); + "stop", vfun1 (fun v -> + let check = decode_check v in + encode_unit_result (Check.stop check) + ); +] + +let version_fields = [ + "string", vfun0 (fun() -> encode_string (Version.string())); + "major", vint (Version.major); + "minor", vint (Version.minor); + "patch", vint (Version.patch); + "isRelease", vbool (Version.is_release); + "suffix", encode_string (Version.suffix); + "hex", vint (Version.hex); +] \ No newline at end of file diff --git a/src/macro/eval/evalMain.ml b/src/macro/eval/evalMain.ml index 5cc40ffa..6a8ff370 100644 --- a/src/macro/eval/evalMain.ml +++ b/src/macro/eval/evalMain.ml @@ -33,6 +33,7 @@ open EvalHash open EvalEncode open EvalField open MacroApi +open Extlib_leftovers (* Create *) @@ -95,6 +96,7 @@ let create com api is_macro = let thread = { tthread = Thread.self(); tstorage = IntMap.empty; + tevents = vnull; tdeque = EvalThread.Deque.create(); } in let eval = EvalThread.create_eval thread in @@ -116,6 +118,7 @@ let create com api is_macro = static_prototypes = new static_prototypes; instance_prototypes = IntMap.empty; constructors = IntMap.empty; + file_keys = com.file_keys; get_object_prototype = get_object_prototype; (* eval *) toplevel = vobject { @@ -137,6 +140,20 @@ let create com api is_macro = select ctx; ignore(Event.sync(Event.receive eval.debug_channel)); end; + (* If no user-defined exception handler is set then follow libuv behavior. + Which is printing an error to stderr and exiting with code 2 *) + Luv.Error.set_on_unhandled_exception (fun ex -> + match ex with + | Sys_exit _ -> raise ex + | _ -> + let msg = + match ex with + | Error.Error (err,_) -> Error.error_msg err + | _ -> Printexc.to_string ex + in + Printf.eprintf "%s\n" msg; + exit 2 + ); t(); ctx @@ -156,7 +173,7 @@ let call_path ctx path f vl api = let vtype = get_static_prototype_as_value ctx (path_hash path) api.pos in let vfield = field vtype (hash f) in let p = api.pos in - let info = create_env_info true p.pfile EKEntrypoint (Hashtbl.create 0) 0 0 in + let info = create_env_info true p.pfile (ctx.file_keys#get p.pfile) EKEntrypoint (Hashtbl.create 0) 0 0 in let env = push_environment ctx info in env.env_leave_pmin <- p.pmin; env.env_leave_pmax <- p.pmax; @@ -197,7 +214,15 @@ let value_signature v = incr cache_length; f() in - let function_count = ref 0 in + let custom_count = ref 0 in + (* Custom format: enumerate custom entities as name_char0, name_char1 etc. *) + let custom_name name_char = + cache v (fun () -> + addc 'F'; + add (string_of_int !custom_count); + incr custom_count + ) + in let rec loop v = match v with | VNull -> addc 'n' | VTrue -> addc 't' @@ -206,6 +231,12 @@ let value_signature v = | VInt32 i -> addc 'i'; add (Int32.to_string i) + | VInt64 i -> + add "i64"; + add (Signed.Int64.to_string i) + | VUInt64 u -> + add "u64"; + add (Unsigned.UInt64.to_string u) | VFloat f -> if f = neg_infinity then addc 'm' else if f = infinity then addc 'p' @@ -288,6 +319,8 @@ let value_signature v = ) | VString s -> adds s.sstring + | VNativeString s -> + add s | VArray {avalues = a} | VVector a -> cache v (fun () -> addc 'a'; @@ -318,12 +351,9 @@ let value_signature v = | VPrototype _ -> die "" __LOC__ | VFunction _ | VFieldClosure _ -> - (* Custom format: enumerate functions as F0, F1 etc. *) - cache v (fun () -> - addc 'F'; - add (string_of_int !function_count); - incr function_count - ) + custom_name 'F' + | VHandle _ -> + custom_name 'H' | VLazy f -> loop (!f()) and loop_fields fields = @@ -335,15 +365,7 @@ let value_signature v = loop v; Digest.string (Buffer.contents buf) -let prepare_callback v n = - match v with - | VFunction _ | VFieldClosure _ -> - let ctx = get_ctx() in - (fun args -> match catch_exceptions ctx (fun() -> call_value v args) null_pos with - | Some v -> v - | None -> vnull) - | _ -> - raise Invalid_expr +let prepare_callback = EvalMisc.prepare_callback let init ctx = () @@ -388,7 +410,7 @@ let compiler_error msg pos = let eval = get_eval ctx in (match eval.env with | Some _ -> - let stack = EvalStdLib.StdNativeStackTrace.make_stack_value (call_stack eval) in + let stack = EvalStackTrace.make_stack_value (call_stack eval) in set_instance_field i key_native_stack stack; | None -> ()); exc vi @@ -564,4 +586,4 @@ let get_api_call_pos () = | None -> env | Some env -> env in - { pfile = rev_hash env.env_info.pfile; pmin = env.env_leave_pmin; pmax = env.env_leave_pmax } \ No newline at end of file + { pfile = rev_hash env.env_info.pfile; pmin = env.env_leave_pmin; pmax = env.env_leave_pmax } diff --git a/src/macro/eval/evalMisc.ml b/src/macro/eval/evalMisc.ml index e8896086..2fbd5e2b 100644 --- a/src/macro/eval/evalMisc.ml +++ b/src/macro/eval/evalMisc.ml @@ -167,6 +167,7 @@ let op_add p v1 v2 = match v1,v2 with | VInt32 i1,VInt32 i2 -> vint32 (Int32.add i1 i2) | VFloat f1,VFloat f2 -> vfloat (f1 +. f2) | VInt32 i,VFloat f | VFloat f,VInt32 i -> vfloat ((Int32.to_float i) +. f) + | VNativeString s1,VNativeString s2 -> vnative_string (s1 ^ s2) | VString s1,VString s2 -> vstring (concat s1 s2) | VString s1,v2 -> vstring (concat s1 (s_value 0 v2)) | v1,VString s2 -> vstring (concat (s_value 0 v1) s2) @@ -254,3 +255,37 @@ let get_binop_fun op p = match op with | OpUShr -> op_ushr p | OpMod -> op_mod p | OpAssign | OpBoolAnd | OpBoolOr | OpAssignOp _ | OpInterval | OpArrow | OpIn -> die "" __LOC__ + +let prepare_callback v n = + match v with + | VFunction _ | VFieldClosure _ -> + let ctx = get_ctx() in + (fun args -> match catch_exceptions ctx (fun() -> call_value v args) null_pos with + | Some v -> v + | None -> vnull) + | _ -> + raise MacroApi.Invalid_expr + +let create_haxe_exception ?stack msg = + let vi = encode_instance key_haxe_Exception in + match vi with + | VInstance i -> + let v_msg = create_unknown (msg) in + set_instance_field i key_exception_message v_msg; + set_instance_field i key_native_exception v_msg; + (match stack with + | Some stack -> + let stack = EvalStackTrace.make_stack stack in + set_instance_field i key_native_stack stack; + | None -> + let ctx = get_ctx() in + let eval = get_eval ctx in + match eval.env with + | Some _ -> + let stack = EvalStackTrace.make_stack_value (call_stack eval) in + set_instance_field i key_native_stack stack; + | None -> () + ); + vi + | _ -> + die "" __LOC__ diff --git a/src/macro/eval/evalPrinting.ml b/src/macro/eval/evalPrinting.ml index 4c3c0912..49f537a9 100644 --- a/src/macro/eval/evalPrinting.ml +++ b/src/macro/eval/evalPrinting.ml @@ -16,7 +16,7 @@ along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. *) - +open Extlib_leftovers open Globals open Type open EvalValue @@ -40,6 +40,7 @@ let rtrue = create_ascii "true" let rfalse = create_ascii "false" let rfun = create_ascii "#fun" let rclosure = create_ascii "#closure" +let rhandle = create_ascii "#handle" let s_date d = let open Unix in @@ -110,6 +111,8 @@ and s_value depth v = else match v with | VNull -> rnull | VInt32 i32 -> create_ascii(Int32.to_string i32) + | VInt64 i -> create_ascii(Signed.Int64.to_string i) + | VUInt64 u -> create_ascii(Unsigned.UInt64.to_string u) | VTrue -> rtrue | VFalse -> rfalse | VFloat f -> @@ -118,8 +121,10 @@ and s_value depth v = create_ascii (if String.unsafe_get s (len - 1) = '.' then String.sub s 0 (len - 1) else s) | VFunction (f,_) -> rfun | VFieldClosure _ -> rclosure + | VHandle _ -> rhandle | VEnumValue ve -> s_enum_value depth ve | VString s -> s + | VNativeString s -> create_unknown_vstring s | VArray va -> s_array (depth + 1) va | VVector vv -> s_vector (depth + 1) vv | VInstance {ikind=IDate d} -> s_date d diff --git a/src/macro/eval/evalPrototype.ml b/src/macro/eval/evalPrototype.ml index 25ea18e3..008bfd99 100644 --- a/src/macro/eval/evalPrototype.ml +++ b/src/macro/eval/evalPrototype.ml @@ -33,7 +33,7 @@ let eval_expr ctx kind e = catch_exceptions ctx (fun () -> let jit,f = jit_expr ctx e in let num_captures = Hashtbl.length jit.captures in - let info = create_env_info true e.epos.pfile kind jit.capture_infos jit.max_num_locals num_captures in + let info = create_env_info true e.epos.pfile (ctx.file_keys#get e.epos.pfile) kind jit.capture_infos jit.max_num_locals num_captures in let env = push_environment ctx info in Std.finally (fun _ -> pop_environment ctx env) f env ) e.Type.epos @@ -41,7 +41,7 @@ let eval_expr ctx kind e = (* Creates constructor function for class [c], if it has a constructor. *) let create_constructor ctx c = match c.cl_constructor with - | Some {cf_expr = Some {eexpr = TFunction tf; epos = pos}} when not c.cl_extern -> + | Some {cf_expr = Some {eexpr = TFunction tf; epos = pos}} when not (has_class_flag c CExtern) -> let key = path_hash c.cl_path in let v = lazy (vfunction (jit_tfunction ctx key key_new tf false pos)) in ctx.constructors <- IntMap.add key v ctx.constructors; @@ -170,7 +170,7 @@ module PrototypeBuilder = struct end let is_removable_field cf = - has_class_field_flag cf CfExtern || Meta.has Meta.Generic cf.cf_meta + has_class_field_flag cf CfExtern || has_class_field_flag cf CfGeneric let is_persistent cf = Meta.has Meta.Persistent cf.cf_meta @@ -194,7 +194,7 @@ let create_static_prototype ctx mt = let pctx = PrototypeBuilder.create ctx key pparent (PClass interfaces) meta in let fields = List.filter (fun cf -> not (is_removable_field cf)) c.cl_ordered_statics in let delays = DynArray.create() in - if not c.cl_extern then List.iter (fun cf -> match cf.cf_kind,cf.cf_expr with + if not (has_class_flag c CExtern) then List.iter (fun cf -> match cf.cf_kind,cf.cf_expr with | Method _,Some {eexpr = TFunction tf; epos = pos} -> let name = hash cf.cf_name in PrototypeBuilder.add_proto_field pctx name (lazy (vstatic_function (jit_tfunction ctx key name tf true pos))); @@ -267,7 +267,7 @@ let create_instance_prototype ctx c = let key = path_hash c.cl_path in let pctx = PrototypeBuilder.create ctx key pparent PInstance None in let fields = List.filter (fun cf -> not (is_removable_field cf)) c.cl_ordered_fields in - if c.cl_extern && c.cl_path <> ([],"String") then + if (has_class_flag c CExtern) && c.cl_path <> ([],"String") then () else List.iter (fun cf -> match cf.cf_kind,cf.cf_expr with | Method meth,Some {eexpr = TFunction tf; epos = pos} -> @@ -278,7 +278,11 @@ let create_instance_prototype ctx c = | Var _,_ when is_physical_field cf -> let name = hash cf.cf_name in PrototypeBuilder.add_instance_field pctx name (lazy vnull); - | _ -> + | Method meth,None when has_class_field_flag cf CfAbstract -> + let name = hash cf.cf_name in + let v = lazy vnull in + PrototypeBuilder.add_proto_field pctx name v + | _ -> () ) fields; PrototypeBuilder.finalize pctx @@ -312,7 +316,7 @@ let add_types ctx types ready = ready mt; ctx.type_cache <- IntMap.add key mt ctx.type_cache; if ctx.debug.support_debugger then begin - let file_key = hash inf.mt_module.m_extra.m_file in + let file_key = hash (Path.UniqueKey.lazy_path inf.mt_module.m_extra.m_file) in if not (Hashtbl.mem ctx.debug.breakpoints file_key) then begin Hashtbl.add ctx.debug.breakpoints file_key (Hashtbl.create 0) end @@ -333,7 +337,7 @@ let add_types ctx types ready = | _ -> false in - List.iter (fun f -> ignore(loop c.cl_super f)) c.cl_overrides; + List.iter (fun f -> if has_class_field_flag f CfOverride then ignore(loop c.cl_super f)) c.cl_ordered_fields; create_constructor ctx c; DynArray.add fl_instance (create_instance_prototype ctx c); DynArray.add fl_static (create_static_prototype ctx mt); diff --git a/src/macro/eval/evalStdLib.ml b/src/macro/eval/evalStdLib.ml index 12f22c82..fb7d30bd 100644 --- a/src/macro/eval/evalStdLib.ml +++ b/src/macro/eval/evalStdLib.ml @@ -16,7 +16,7 @@ along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. *) - +open Extlib_leftovers open Globals open EvalValue open EvalEncode @@ -42,17 +42,6 @@ let ptmap_keys h = let hashtbl_keys h = Hashtbl.fold (fun k _ acc -> k :: acc) h [] -let encode_i64 low high = - let vi = create_instance key_haxe__Int64____Int64 in - set_instance_field vi key_high (vint32 high); - set_instance_field vi key_low (vint32 low); - vinstance vi - -let encode_i64_direct i64 = - let low = Int64.to_int32 i64 in - let high = Int64.to_int32 (Int64.shift_right_logical i64 32) in - encode_i64 low high - module StdEvalVector = struct let this this = match this with | VVector vv -> vv @@ -344,7 +333,7 @@ module StdBytes = struct try let low = read_i32 this pos in let high = read_i32 this (pos + 4) in - encode_i64 low high; + EvalIntegers.encode_haxe_i64 low high; with _ -> outside_bounds() ) @@ -546,46 +535,6 @@ module StdBytesBuffer = struct ) end -module StdNativeStackTrace = struct - let make_stack envs = - let l = DynArray.create () in - List.iter (fun (pos,kind) -> - let file_pos s = - let line1,col1,_,_ = Lexer.get_pos_coords pos in - encode_enum_value key_haxe_StackItem 2 [|s;create_unknown pos.pfile;vint line1;vint col1|] None - in - match kind with - | EKLocalFunction i -> - let local_function = encode_enum_value key_haxe_StackItem 4 [|vint i|] None in - DynArray.add l (file_pos local_function); - | EKMethod(st,sf) -> - let local_function = encode_enum_value key_haxe_StackItem 3 [|create_unknown (rev_hash st); create_unknown (rev_hash sf)|] None in - DynArray.add l (file_pos local_function); - | EKEntrypoint -> - () - ) envs; - encode_array (DynArray.to_list l) - - let make_stack_value envs = - make_stack (List.map (fun env -> {pfile = rev_hash env.env_info.pfile;pmin = env.env_leave_pmin; pmax = env.env_leave_pmax},env.env_info.kind) envs) - - let getCallStack = vfun0 (fun () -> - let ctx = get_ctx() in - let envs = call_stack (get_eval ctx) in - let envs = match envs with - | _ :: _ :: envs -> envs (* Skip calls to callStack() and getCallStack() *) - | _ -> envs - in - make_stack_value envs - ) - - let getExceptionStack = vfun0 (fun () -> - let ctx = get_ctx() in - let envs = ctx.exception_stack in - make_stack (List.rev envs) - ) -end - module StdCompress = struct open Extc @@ -664,6 +613,8 @@ module StdContext = struct Hashtbl.find GlobalState.macro_lib f ) + let plugins = ref PMap.empty + let plugin_data = ref None let register data = plugin_data := Some data @@ -671,12 +622,18 @@ module StdContext = struct let loadPlugin = vfun1 (fun filePath -> let filePath = decode_string filePath in let filePath = Dynlink.adapt_filename filePath in - (try Dynlink.loadfile filePath with Dynlink.Error error -> exc_string (Dynlink.error_message error)); - match !plugin_data with - | None -> - vnull - | Some l -> - encode_obj_s l + if PMap.mem filePath !plugins then + PMap.find filePath !plugins + else begin + (try Dynlink.loadfile filePath with Dynlink.Error error -> exc_string (Dynlink.error_message error)); + match !plugin_data with + | Some l -> + let vapi = encode_obj_s l in + plugins := PMap.add filePath vapi !plugins; + vapi + | None -> + vnull + end ) end @@ -971,25 +928,45 @@ module StdEReg = struct let split = vifun1 (fun vthis s -> let this = this vthis in let s = decode_string s in - if String.length s = 0 then encode_array [v_empty_string] + let slength = String.length s in + if slength = 0 then + encode_array [v_empty_string] else begin - let max = if this.r_global then -1 else 2 in - let l = Pcre.full_split ~iflags:0x2000 ~max ~rex:this.r s in - let rec loop split cur acc l = match l with - | Text s :: l -> - loop split (cur ^ s) acc l - | Delim s :: l -> - if split then - loop this.r_global "" ((create_unknown cur) :: acc) l + let copy_offset = ref 0 in + let acc = DynArray.create () in + let add first last = + let sub = String.sub s first (last - first) in + DynArray.add acc (create_unknown sub) + in + let exec = Pcre.exec ~iflags:0x2000 ~rex:this.r in + let step pos = + try + let substrings = exec ~pos s in + let (first,last) = Pcre.get_substring_ofs substrings 0 in + add !copy_offset first; + copy_offset := last; + let next_start = if pos = last then last + 1 else last in + if next_start >= slength then begin + DynArray.add acc (create_unknown ""); + None + end else + Some next_start + with Not_found -> + add !copy_offset slength; + None + in + let rec loop pos = + match step pos with + | Some next -> + if this.r_global then + loop next else - loop false (cur ^ s) acc l - | _ :: l -> - loop split cur acc l - | [] -> - List.rev ((create_unknown cur) :: acc) + add !copy_offset slength + | _ -> + () in - let l = loop true "" [] l in - encode_array l + loop 0; + encode_array (DynArray.to_list acc) end ) end @@ -1169,7 +1146,7 @@ module StdFPHelper = struct let doubleToI64 = vfun1 (fun v -> let f = num v in let i64 = Int64.bits_of_float f in - encode_i64_direct i64 + EvalIntegers.encode_haxe_i64_direct i64 ) let floatToI32 = vfun1 (fun f -> @@ -2194,7 +2171,7 @@ module StdStd = struct ) let parseFloat = vfun1 (fun v -> - try vfloat (Numeric.parse_float (decode_string v)) with _ -> vnull + try vfloat (Numeric.parse_float (decode_string v)) with _ -> vfloat nan ) let random = vfun1 (fun v -> @@ -2705,6 +2682,15 @@ module StdThread = struct vint (Thread.id (this vthis).tthread) ) + let get_events = vifun0 (fun vthis -> + (this vthis).tevents + ) + + let set_events = vifun1 (fun vthis v -> + (this vthis).tevents <- v; + v + ) + let join = vfun1 (fun thread -> Thread.join (this thread).tthread; vnull @@ -2983,6 +2969,7 @@ module StdType = struct 7,[|get_static_prototype_as_value ctx ve.epath null_pos|] | VLazy f -> loop (!f()) + | VInt64 _ | VUInt64 _ | VNativeString _ | VHandle _ -> 8,[||] in let i,vl = loop v in encode_enum_value key_ValueType i vl None @@ -3086,6 +3073,70 @@ module StdUtf8 = struct ) end +module StdNativeString = struct + let from_string = vfun1 (fun v -> + let s = decode_vstring v in + vnative_string s.sstring + ) + + let from_bytes = vfun1 (fun v -> + let b = decode_bytes v in + vnative_string (Bytes.to_string b) + ) + + let to_string = vfun1 (fun v -> + let s = decode_native_string v in + create_unknown s + ) + + let to_bytes = vfun1 (fun v -> + let s = decode_native_string v in + encode_bytes (Bytes.of_string s) + ) + + let concat = vfun2 (fun v1 v2 -> + let s1 = decode_native_string v1 + and s2 = decode_native_string v2 in + vnative_string (s1 ^ s2) + ) + + let char = vfun2 (fun v1 v2 -> + let s = decode_native_string v1 + and index = decode_int v2 in + try encode_string (String.make 1 s.[index]) + with Invalid_argument s -> throw_string s null_pos + ) + + let code = vfun2 (fun v1 v2 -> + let s = decode_native_string v1 + and index = decode_int v2 in + try vint (int_of_char s.[index]) + with Invalid_argument s -> throw_string s null_pos + ) + + let get_length = vfun1 (fun v -> + let s = decode_native_string v in + vint (String.length s) + ) + + let sub = vfun3 (fun v1 v2 v3 -> + let s = decode_native_string v1 + and start = decode_int v2 in + let max_length = String.length s - start in + try + if v3 = VNull then + vnative_string (String.sub s start max_length) + else + let length = + let l = decode_int v3 in + if l > max_length then max_length else l + in + vnative_string (String.sub s start length) + with Invalid_argument _ -> + throw_string "Invalid arguments for eval.NativeString.sub" null_pos + ) +end + let init_fields builtins path static_fields instance_fields = let map (name,v) = (hash name,v) in let path = path_hash path in @@ -3342,8 +3393,8 @@ let init_standard_library builtins = "getBytes",StdBytesBuffer.getBytes; ]; init_fields builtins (["haxe"],"NativeStackTrace") [ - "_callStack",StdNativeStackTrace.getCallStack; - "exceptionStack",StdNativeStackTrace.getExceptionStack; + "_callStack",EvalStackTrace.getCallStack; + "exceptionStack",EvalStackTrace.getExceptionStack; ] []; init_fields builtins (["haxe";"zip"],"Compress") [ "run",StdCompress.run; @@ -3637,6 +3688,8 @@ let init_standard_library builtins = "yield",StdThread.yield; ] [ "id",StdThread.id; + "get_events",StdThread.get_events; + "set_events",StdThread.set_events; "kill",StdThread.kill; "sendMessage",StdThread.sendMessage; ]; @@ -3686,4 +3739,65 @@ let init_standard_library builtins = "addChar",StdUtf8.addChar; "toString",StdUtf8.toString; ]; + init_fields builtins (["eval";"_NativeString"],"NativeString_Impl_") [ + "fromBytes",StdNativeString.from_bytes; + "fromString",StdNativeString.from_string; + "toBytes",StdNativeString.to_bytes; + "toString",StdNativeString.to_string; + "concat",StdNativeString.concat; + "char",StdNativeString.char; + "code",StdNativeString.code; + "get_length",StdNativeString.get_length; + "sub",StdNativeString.sub; + ] []; + init_fields builtins (["eval";"integers";"_UInt64"],"UInt64_Impl_") EvalIntegers.uint64_fields []; + init_fields builtins (["eval";"integers";"_Int64"],"Int64_Impl_") EvalIntegers.int64_fields []; + init_fields builtins (["eval";"luv";"_UVError"],"UVError_Impl_") EvalLuv.uv_error_fields []; + init_fields builtins (["eval";"luv";"_Loop"],"Loop_Impl_") EvalLuv.loop_fields []; + init_fields builtins (["eval";"luv";"_Loop"],"LoopOption_Impl_") ["sigprof",vint Luv.Loop.Option.sigprof] []; + init_fields builtins (["eval";"luv";"_Handle"],"Handle_Impl_") EvalLuv.handle_fields []; + init_fields builtins (["eval";"luv";"_Idle"], "Idle_Impl_") EvalLuv.idle_fields []; + init_fields builtins (["eval";"luv";"_Async"], "Async_Impl_") EvalLuv.async_fields []; + init_fields builtins (["eval";"luv";"_Timer"], "Timer_Impl_") EvalLuv.timer_fields []; + init_fields builtins (["eval";"luv";"_Buffer"], "Buffer_Impl_") EvalLuv.buffer_fields []; + init_fields builtins (["eval";"luv";"_SockAddr"], "SockAddr_Impl_") EvalLuv.sockaddr_fields []; + init_fields builtins (["eval";"luv";"_Tcp"], "Tcp_Impl_") EvalLuv.tcp_fields []; + init_fields builtins (["eval";"luv";"_Udp"], "Udp_Impl_") EvalLuv.udp_fields []; + init_fields builtins (["eval";"luv";"_ConnectedUdp"], "ConnectedUdp_Impl_") EvalLuv.connected_udp_fields []; + init_fields builtins (["eval";"luv";"_Pipe"], "Pipe_Impl_") EvalLuv.pipe_fields []; + init_fields builtins (["eval";"luv";"_Tty"], "Tty_Impl_") EvalLuv.tty_fields []; + init_fields builtins (["eval";"luv";"_Stream"], "Stream_Impl_") EvalLuv.stream_fields []; + init_fields builtins (["eval";"luv";"_Signal"], "Signal_Impl_") EvalLuv.signal_fields []; + init_fields builtins (["eval";"luv";"_Signal"], "SigNum_Impl_") EvalLuv.signum_fields []; + init_fields builtins (["eval";"luv";"_Process"], "Process_Impl_") EvalLuv.process_fields []; + init_fields builtins (["eval";"luv";"_Request"], "Request_Impl_") EvalLuv.request_fields []; + init_fields builtins (["eval";"luv"], "Dns") EvalLuv.dns_fields []; + init_fields builtins (["eval";"luv";"_File"], "File_Impl_") EvalLuv.file_fields []; + init_fields builtins (["eval";"luv";"_Dir"], "Dir_Impl_") EvalLuv.dir_fields []; + init_fields builtins (["eval";"luv"], "FileSync") EvalLuv.file_sync_fields []; + init_fields builtins (["eval";"luv"], "DirSync") EvalLuv.dir_sync_fields []; + init_fields builtins (["eval";"luv";"_FsEvent"], "FsEvent_Impl_") EvalLuv.fs_event_fields []; + init_fields builtins (["eval";"luv"], "ThreadPool") EvalLuv.thread_pool_fields []; + init_fields builtins (["eval";"luv";"_Thread"], "Thread_Impl_") EvalLuv.thread_fields []; + init_fields builtins (["eval";"luv";"_Once"], "Once_Impl_") EvalLuv.once_fields []; + init_fields builtins (["eval";"luv";"_Mutex"], "Mutex_Impl_") EvalLuv.mutex_fields []; + init_fields builtins (["eval";"luv";"_RwLock"], "RwLock_Impl_") EvalLuv.rwlock_fields []; + init_fields builtins (["eval";"luv";"_Semaphore"], "Semaphore_Impl_") EvalLuv.semaphore_fields []; + init_fields builtins (["eval";"luv";"_Condition"], "Condition_Impl_") EvalLuv.condition_fields []; + init_fields builtins (["eval";"luv";"_Barrier"], "Barrier_Impl_") EvalLuv.barrier_fields []; + init_fields builtins (["eval";"luv"], "Env") EvalLuv.env_fields []; + init_fields builtins (["eval";"luv"], "Time") EvalLuv.time_fields []; + init_fields builtins (["eval";"luv"], "Path") EvalLuv.path_fields []; + init_fields builtins (["eval";"luv"], "Random") EvalLuv.random_fields []; + init_fields builtins (["eval";"luv"], "RandomSync") EvalLuv.random_sync_fields []; + init_fields builtins (["eval";"luv"], "Network") EvalLuv.network_fields []; + init_fields builtins (["eval";"luv";"_FsPoll"], "FsPoll_Impl_") EvalLuv.fs_poll_fields []; + init_fields builtins (["eval";"luv"], "Resource") EvalLuv.resource_fields []; + init_fields builtins (["eval";"luv"], "SystemInfo") EvalLuv.system_info_fields []; + init_fields builtins (["eval";"luv"], "Pid") EvalLuv.pid_fields []; + init_fields builtins (["eval";"luv"], "Passwd") EvalLuv.passwd_fields []; + init_fields builtins (["eval";"luv"], "Metrics") EvalLuv.metrics_fields []; + init_fields builtins (["eval";"luv";"_Prepare"], "Prepare_Impl_") EvalLuv.prepare_fields []; + init_fields builtins (["eval";"luv";"_Check"], "Check_Impl_") EvalLuv.check_fields []; + init_fields builtins (["eval";"luv"], "Version") EvalLuv.version_fields []; EvalSsl.init_fields init_fields builtins \ No newline at end of file diff --git a/src/macro/eval/evalString.ml b/src/macro/eval/evalString.ml index fba780fc..047a6e4d 100644 --- a/src/macro/eval/evalString.ml +++ b/src/macro/eval/evalString.ml @@ -16,7 +16,7 @@ along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. *) - +open Extlib_leftovers open EvalValue let vstring s = VString s @@ -38,8 +38,11 @@ let empty_string = create_ascii "" let v_empty_string = VString empty_string +let create_unknown_vstring s = + create_with_length s (try UTF8.length s with _ -> String.length s) + let create_unknown s = - vstring (create_with_length s (try UTF8.length s with _ -> String.length s)) + vstring (create_unknown_vstring s) let concat s1 s2 = create_with_length (s1.sstring ^ s2.sstring) (s1.slength + s2.slength) diff --git a/src/macro/eval/evalThread.ml b/src/macro/eval/evalThread.ml index 24719942..708b7e9e 100644 --- a/src/macro/eval/evalThread.ml +++ b/src/macro/eval/evalThread.ml @@ -77,41 +77,61 @@ let create_eval thread = { caught_exception = vnull; } -let spawn ctx f = - let f thread = - let id = Thread.id (Thread.self()) in - let maybe_send_thread_event reason = match ctx.debug.debug_socket with - | Some socket -> - socket.connection.send_thread_event id reason - | None -> - () - in - let new_eval = create_eval thread in - ctx.evals <- IntMap.add id new_eval ctx.evals; - let close () = - ctx.evals <- IntMap.remove id ctx.evals; - maybe_send_thread_event "exited"; - in - try - maybe_send_thread_event "started"; - ignore(f ()); - close(); - with - | RunTimeException(v,stack,p) -> - let msg = get_exc_error_message ctx v stack p in - prerr_endline msg; - close(); - | Sys_exit i -> - close(); - exit i; - | exc -> - close(); - raise exc +let run ctx f thread = + let id = Thread.id (Thread.self()) in + let maybe_send_thread_event reason = match ctx.debug.debug_socket with + | Some socket -> + socket.connection.send_thread_event id reason + | None -> + () + in + let new_eval = create_eval thread in + ctx.evals <- IntMap.add id new_eval ctx.evals; + let close () = + ctx.evals <- IntMap.remove id ctx.evals; + maybe_send_thread_event "exited"; in + try + maybe_send_thread_event "started"; + ignore(f ()); + close(); + with + | RunTimeException(v,stack,p) -> + let msg = get_exc_error_message ctx v stack p in + prerr_endline msg; + close(); + | Sys_exit i -> + close(); + exit i; + | exc -> + close(); + raise exc + +let spawn ctx f = let thread = { tthread = Obj.magic (); tstorage = IntMap.empty; + tevents = vnull; tdeque = Deque.create(); } in - thread.tthread <- Thread.create f thread; - thread \ No newline at end of file + thread.tthread <- Thread.create (run ctx f) thread; + thread + +(** + Just executes `f` if called from a Haxe thread. + Otherwise creates Haxe thread data structures, runs `f` and then cleans up + created data. +*) +let run ctx f = + let id = Thread.id (Thread.self()) in + if IntMap.mem id ctx.evals then + ignore(f()) + else begin + let thread = { + tthread = Thread.self(); + tstorage = IntMap.empty; + tevents = vnull; + tdeque = Deque.create(); + } in + run ctx f thread + end \ No newline at end of file diff --git a/src/macro/eval/evalValue.ml b/src/macro/eval/evalValue.ml index af94c20b..3468a890 100644 --- a/src/macro/eval/evalValue.ml +++ b/src/macro/eval/evalValue.ml @@ -16,7 +16,7 @@ along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. *) - +open Extlib_leftovers open Globals open EvalHash @@ -93,6 +93,40 @@ type vprototype_kind = | PInstance | PObject +type vhandle = + | HLoop of Luv.Loop.t + | HIdle of Luv.Idle.t + | HTimer of Luv.Timer.t + | HAsync of Luv.Async.t + | HBuffer of Luv.Buffer.t + | HSockAddr of Luv.Sockaddr.t + | HTcp of Luv.TCP.t + | HUdp of Luv.UDP.t + | HPipe of Luv.Pipe.t + | HTty of Luv.TTY.t + | HFile of Luv.File.t + | HDir of Luv.File.Dir.t + | HSignal of Luv.Signal.t + | HProcess of Luv.Process.t + | HRedirection of Luv.Process.redirection + | HAddrRequest of Luv.DNS.Addr_info.Request.t + | HNameRequest of Luv.DNS.Name_info.Request.t + | HFileRequest of Luv.File.Request.t + | HRandomRequest of Luv.Random.Request.t + | HThreadPoolRequest of Luv.Thread_pool.Request.t + | HFileModeNumeric of Luv.File.Mode.numeric + | HFsEvent of Luv.FS_event.t + | HThread of Luv.Thread.t + | HOnce of Luv.Once.t + | HMutex of Luv.Mutex.t + | HRwLock of Luv.Rwlock.t + | HSemaphore of Luv.Semaphore.t + | HCondition of Luv.Condition.t + | HBarrier of Luv.Barrier.t + | HFsPoll of Luv.FS_poll.t + | HPrepare of Luv.Prepare.t + | HCheck of Luv.Check.t + type value = | VNull | VTrue @@ -109,6 +143,10 @@ type value = | VFunction of vfunc * bool | VFieldClosure of value * vfunc | VLazy of (unit -> value) ref + | VNativeString of string + | VHandle of vhandle + | VInt64 of Signed.Int64.t + | VUInt64 of Unsigned.UInt64.t and vfunc = value list -> value @@ -203,6 +241,7 @@ and venum_value = { and vthread = { mutable tthread : Thread.t; tdeque : vdeque; + mutable tevents : value; mutable tstorage : value IntMap.t; } @@ -220,6 +259,48 @@ and vlock = { ldeque : vdeque; } +let same_handle h1 h2 = + match h1, h2 with + | HLoop h1, HLoop h2 -> h1 == h2 + | HIdle h1, HIdle h2 -> h1 == h2 + | HTimer h1, HTimer h2 -> h1 == h2 + | HAsync h1, HAsync h2 -> h1 == h2 + | HBuffer h1, HBuffer h2 -> h1 == h2 + | HSockAddr h1, HSockAddr h2 -> h1 == h2 + | HTcp h1, HTcp h2 -> h1 == h2 + | HPipe h1, HPipe h2 -> h1 == h2 + | HTty h1, HTty h2 -> h1 == h2 + | HFile h1, HFile h2 -> h1 == h2 + | HDir h1, HDir h2 -> h1 == h2 + | HUdp h1, HUdp h2 -> h1 == h2 + | HSignal h1, HSignal h2 -> h1 == h2 + | HProcess h1, HProcess h2 -> h1 == h2 + | HRedirection h1, HRedirection h2 -> h1 == h2 + | HFileRequest h1, HFileRequest h2 -> h1 == h2 + | HNameRequest h1, HNameRequest h2 -> h1 == h2 + | HAddrRequest h1, HAddrRequest h2 -> h1 == h2 + | HRandomRequest h1, HRandomRequest h2 -> h1 == h2 + | HThreadPoolRequest h1, HThreadPoolRequest h2 -> h1 == h2 + | HFileModeNumeric h1, HFileModeNumeric h2 -> h1 == h2 + | HFsEvent h1, HFsEvent h2 -> h1 == h2 + | HThread h1, HThread h2 -> Luv.Thread.equal h1 h2 + | HOnce h1, HOnce h2 -> h1 == h2 + | HMutex h1, HMutex h2 -> h1 == h2 + | HRwLock h1, HRwLock h2 -> h1 == h2 + | HSemaphore h1, HSemaphore h2 -> h1 == h2 + | HCondition h1, HCondition h2 -> h1 == h2 + | HBarrier h1, HBarrier h2 -> h1 == h2 + | HFsPoll h1, HFsPoll h2 -> h1 == h2 + | HPrepare h1, HPrepare h2 -> h1 == h2 + | HCheck h1, HCheck h2 -> h1 == h2 + | HBuffer _,_ | HAsync _,_ | HTimer _, _ | HLoop _, _ | HIdle _, _ | HSockAddr _, _ + | HTcp _, _ | HPipe _, _ | HTty _, _ | HFile _, _ | HUdp _, _ | HSignal _, _ + | HProcess _, _ | HRedirection _, _| HFileRequest _, _ | HAddrRequest _, _ + | HNameRequest _, _ | HRandomRequest _, _ | HThreadPoolRequest _, _ + | HFileModeNumeric _, _ | HDir _, _ | HFsEvent _, _ | HThread _, _ | HOnce _, _ + | HMutex _, _ | HRwLock _, _ | HSemaphore _, _ | HCondition _, _ | HBarrier _, _ + | HFsPoll _, _ | HPrepare _, _ | HCheck _, _ -> false + let rec equals a b = match a,b with | VTrue,VTrue | VFalse,VFalse @@ -236,6 +317,8 @@ let rec equals a b = match a,b with | VVector vv1,VVector vv2 -> vv1 == vv2 | VFunction(vf1,_),VFunction(vf2,_) -> vf1 == vf2 | VPrototype proto1,VPrototype proto2 -> proto1.ppath = proto2.ppath + | VNativeString s1,VNativeString s2 -> s1 = s2 + | VHandle h1,VHandle h2 -> same_handle h1 h2 | VLazy f1,_ -> equals (!f1()) b | _,VLazy f2 -> equals a (!f2()) | _ -> a == b @@ -262,6 +345,7 @@ let vint i = VInt32 (Int32.of_int i) let vint32 i = VInt32 i let vfloat f = VFloat f let venum_value e = VEnumValue e +let vnative_string s = VNativeString s let s_expr_pretty e = (Type.s_expr_pretty false "" false (Type.s_type (Type.print_context())) e) diff --git a/src/macro/macroApi.ml b/src/macro/macroApi.ml index e0d3e20c..25c97514 100644 --- a/src/macro/macroApi.ml +++ b/src/macro/macroApi.ml @@ -270,6 +270,7 @@ let encode_unop op = | Not -> 2 | Neg -> 3 | NegBits -> 4 + | Spread -> 5 in encode_enum IUnop tag [] @@ -314,6 +315,8 @@ and encode_access a = | AMacro -> 6 | AFinal -> 7 | AExtern -> 8 + | AAbstract -> 9 + | AOverload -> 10 in encode_enum ~pos:(Some (pos a)) IAccess tag [] @@ -439,13 +442,14 @@ and encode_expr e = | EUnop (op,flag,e) -> 9, [encode_unop op; vbool (match flag with Prefix -> false | Postfix -> true); loop e] | EVars vl -> - 10, [encode_array (List.map (fun (v,final,t,eo) -> + 10, [encode_array (List.map (fun v -> encode_obj [ - "name",encode_placed_name v; - "name_pos",encode_pos (pos v); - "isFinal",vbool final; - "type",null encode_ctype t; - "expr",null loop eo; + "name",encode_placed_name v.ev_name; + "name_pos",encode_pos (pos v.ev_name); + "isFinal",vbool v.ev_final; + "type",null encode_ctype v.ev_type; + "expr",null loop v.ev_expr; + "meta",encode_meta_content v.ev_meta; ] ) vl)] | EFunction (kind,f) -> @@ -499,6 +503,8 @@ and encode_expr e = 27, [loop e; encode_ctype t] | EMeta (m,e) -> 28, [encode_meta_entry m;loop e] + | EIs (e,t) -> + 29, [loop e;encode_ctype t] in encode_obj [ "pos", encode_pos p; @@ -586,6 +592,7 @@ let decode_unop op = | 2, [] -> Not | 3, [] -> Neg | 4, [] -> NegBits + | 5, [] -> Spread | _ -> raise Invalid_expr let decode_import_mode t = @@ -663,6 +670,8 @@ and decode_access v = | 6 -> AMacro | 7 -> AFinal | 8 -> AExtern + | 9 -> AAbstract + | 10 -> AOverload | _ -> raise Invalid_expr in a,p @@ -674,17 +683,19 @@ and decode_meta_content m = decode_opt_array decode_meta_entry m and decode_doc = opt (fun s -> { doc_own = Some (decode_string s); doc_inherited = [] }) +and decode_class_field_kind v = + match decode_enum v with + | 0, [t;e] -> + FVar (opt decode_ctype t, opt decode_expr e) + | 1, [f] -> + FFun (decode_fun f) + | 2, [get;set; t; e] -> + FProp (decode_placed_name vnull get, decode_placed_name vnull set, opt decode_ctype t, opt decode_expr e) + | _ -> + raise Invalid_expr + and decode_field v = - let fkind = match decode_enum (field v "kind") with - | 0, [t;e] -> - FVar (opt decode_ctype t, opt decode_expr e) - | 1, [f] -> - FFun (decode_fun f) - | 2, [get;set; t; e] -> - FProp (decode_placed_name vnull get, decode_placed_name vnull set, opt decode_ctype t, opt decode_expr e) - | _ -> - raise Invalid_expr - in + let fkind = decode_class_field_kind (field v "kind") in let pos = decode_pos (field v "pos") in { cff_name = (decode_string (field v "name"),decode_pos_default (field v "name_pos") pos); @@ -771,7 +782,12 @@ and decode_expr v = EVars (List.map (fun v -> let vfinal = field v "isFinal" in let final = if vfinal == vnull then false else decode_bool vfinal in - ((decode_placed_name (field v "name_pos") (field v "name")),final,opt decode_ctype (field v "type"),opt loop (field v "expr")) + let vmeta = field v "meta" in + let meta = if vmeta == vnull then [] else decode_meta_content vmeta in + let name = (decode_placed_name (field v "name_pos") (field v "name")) + and t = opt decode_ctype (field v "type") + and eo = opt loop (field v "expr") in + mk_evar ~final ?t ?eo ~meta name ) (decode_array vl)) | 11, [kind;f] -> EFunction (decode_function_kind kind,decode_fun f) @@ -815,8 +831,8 @@ and decode_expr v = ECheckType (loop e, (decode_ctype t)) | 28, [m;e] -> EMeta (decode_meta_entry m,loop e) - | 29, [e;f] -> - EField (loop e, decode_string f) (*** deprecated EType, keep until haxe 3 **) + | 29, [e;t] -> + EIs (loop e,decode_ctype t) | _ -> raise Invalid_expr in @@ -939,6 +955,7 @@ and encode_cfield f = "overloads", encode_ref f.cf_overloads (encode_and_map_array encode_cfield) (fun() -> "overloads"); "isExtern", vbool (has_class_field_flag f CfExtern); "isFinal", vbool (has_class_field_flag f CfFinal); + "isAbstract", vbool (has_class_field_flag f CfAbstract); ] and encode_field_kind k = @@ -953,7 +970,6 @@ and encode_var_access a = | AccNormal -> 0, [] | AccNo -> 1, [] | AccNever -> 2, [] - | AccResolve -> 3, [] | AccCall -> 4, [] | AccInline -> 5, [] | AccRequire (s,msg) -> 6, [encode_string s; null encode_string msg] @@ -974,7 +990,7 @@ and encode_class_kind k = let tag, pl = (match k with | KNormal -> 0, [] | KTypeParameter pl -> 1, [encode_tparams pl] - (* KExtension was here *) + | KModuleFields m -> 2, [encode_string (s_type_path m.m_path)] | KExpr e -> 3, [encode_expr e] | KGeneric -> 4, [] | KGenericInstance (cl, params) -> 5, [encode_clref cl; encode_tparams params] @@ -988,10 +1004,11 @@ and encode_tclass c = ignore(c.cl_build()); encode_mtype (TClassDecl c) [ "kind", encode_class_kind c.cl_kind; - "isExtern", vbool c.cl_extern; - "exclude", vfun0 (fun() -> c.cl_extern <- true; c.cl_init <- None; vnull); - "isInterface", vbool c.cl_interface; - "isFinal", vbool c.cl_final; + "isExtern", vbool (has_class_flag c CExtern); + "exclude", vfun0 (fun() -> add_class_flag c CExtern; c.cl_init <- None; vnull); + "isInterface", vbool (has_class_flag c CInterface); + "isFinal", vbool (has_class_flag c CFinal); + "isAbstract", vbool (has_class_flag c CAbstract); "superClass", (match c.cl_super with | None -> vnull | Some (c,pl) -> encode_obj ["t",encode_clref c;"params",encode_tparams pl] @@ -1001,7 +1018,7 @@ and encode_tclass c = "statics", encode_ref c.cl_ordered_statics (encode_and_map_array encode_cfield) (fun() -> "class fields"); "constructor", (match c.cl_constructor with None -> vnull | Some cf -> encode_cfref cf); "init", (match c.cl_init with None -> vnull | Some e -> encode_texpr e); - "overrides", (encode_array (List.map encode_cfref c.cl_overrides)) + "overrides", (encode_array (List.map encode_cfref (List.filter (fun cf -> has_class_field_flag cf CfOverride) c.cl_ordered_fields))) ] and encode_ttype t = @@ -1020,7 +1037,6 @@ and encode_tanon a = and encode_anon_status s = let tag, pl = (match s with | Closed -> 0, [] - | Opened -> 1, [] | Type.Const -> 2, [] | Extend tl -> 3, [encode_ref tl (fun tl -> encode_array (List.map encode_type tl)) (fun() -> "")] | Statics cl -> 4, [encode_clref cl] @@ -1140,17 +1156,17 @@ and encode_tconst c = encode_enum ITConstant tag pl and encode_tvar v = - let f_extra (pl,e) = + let f_extra ve = encode_obj [ - "params",encode_type_params pl; - "expr",vopt encode_texpr e + "params",encode_type_params ve.v_params; + "expr",vopt encode_texpr ve.v_expr; ] in encode_obj [ "id", vint v.v_id; "name", encode_string v.v_name; "t", encode_type v.v_type; - "capture", vbool v.v_capture; + "capture", vbool (has_var_flag v VCaptured); "extra", vopt f_extra v.v_extra; "meta", encode_meta v.v_meta (fun m -> v.v_meta <- m); "$", encode_unsafe (Obj.repr v); @@ -1278,7 +1294,6 @@ let decode_var_access v = | 0, [] -> AccNormal | 1, [] -> AccNo | 2, [] -> AccNever - | 3, [] -> AccResolve | 4, [] -> AccCall | 5, [] -> AccInline | 6, [s1;s2] -> AccRequire(decode_string s1, opt decode_string s2) @@ -1303,6 +1318,7 @@ let decode_cfield v = let public = decode_bool (field v "isPublic") in let extern = decode_bool (field v "isExtern") in let final = decode_bool (field v "isFinal") in + let abstract = decode_bool (field v "isAbstract") in let cf = { cf_name = decode_string (field v "name"); cf_type = decode_type (field v "type"); @@ -1320,19 +1336,22 @@ let decode_cfield v = if public then add_class_field_flag cf CfPublic; if extern then add_class_field_flag cf CfExtern; if final then add_class_field_flag cf CfFinal; + if abstract then add_class_field_flag cf CfAbstract; cf let decode_efield v = - { - ef_name = decode_string (field v "name"); - ef_type = decode_type (field v "type"); - ef_pos = decode_pos (field v "pos"); - ef_name_pos = decode_pos (field v "namePos"); - ef_index = decode_int (field v "index"); - ef_meta = []; (* TODO *) - ef_doc = decode_doc (field v "doc"); - ef_params = decode_type_params (field v "params") - } + let rec get_enum t = + match follow t with + | TEnum (enm,_) -> enm + | TFun (_,t) -> get_enum t + | _ -> raise Not_found + in + let name = decode_string (field v "name") in + try + let enm = get_enum (decode_type (field v "type")) in + PMap.find name enm.e_constrs + with Not_found -> + raise Invalid_expr let decode_field_access v = match decode_enum v with @@ -1451,10 +1470,11 @@ let decode_type_def v = EEnum (mk (if isExtern then [EExtern] else []) (List.map conv fields)) | 1, [] -> ETypedef (mk (if isExtern then [EExtern] else []) (CTAnonymous fields,Globals.null_pos)) - | 2, [ext;impl;interf;final] -> + | 2, [ext;impl;interf;final;abstract] -> let flags = if isExtern then [HExtern] else [] in let is_interface = decode_opt_bool interf in let is_final = decode_opt_bool final in + let is_abstract = decode_opt_bool abstract in let interfaces = (match opt (fun v -> List.map decode_path (decode_array v)) impl with Some l -> l | _ -> [] ) in let flags = (match opt decode_path ext with None -> flags | Some t -> HExtends t :: flags) in let flags = if is_interface then begin @@ -1465,6 +1485,7 @@ let decode_type_def v = end in let flags = if is_final then HFinal :: flags else flags in + let flags = if is_abstract then HAbstract :: flags else flags in EClass (mk flags fields) | 3, [t] -> ETypedef (mk (if isExtern then [EExtern] else []) (decode_ctype t)) @@ -1473,6 +1494,11 @@ let decode_type_def v = let flags = match opt decode_array tto with None -> flags | Some ta -> (List.map (fun t -> AbTo (decode_ctype t)) ta) @ flags in let flags = match opt decode_ctype tthis with None -> flags | Some t -> (AbOver t) :: flags in EAbstract(mk flags fields) + | 5, [fk;al] -> + let fk = decode_class_field_kind fk in + let al = List.map decode_access (opt_list decode_array al) in + (* let al = if isExtern then (AExtern,pos) :: al else al in *) + EStatic (mk al fk) | _ -> raise Invalid_expr ) in @@ -1525,8 +1551,9 @@ let macro_api ccom get_api = let dfile = display_pos#get.pfile in dfile = p.pfile || ( + let com = ccom() in (Filename.is_relative p.pfile || Filename.is_relative dfile) - && (Path.UniqueKey.create dfile = Path.UniqueKey.create p.pfile) + && (com.file_keys#get dfile = com.file_keys#get p.pfile) ) in vbool (display_pos#enclosed_in p && same_file()) @@ -1658,9 +1685,6 @@ let macro_api ccom get_api = let f = if decode_opt_bool b then Type.s_expr_pretty false "" false else Type.s_expr_ast true "" in encode_string (f (Type.s_type (print_context())) (decode_texpr v)) ); - "is_fmt_string", vfun1 (fun p -> - vbool (Lexer.is_fmt_string (decode_pos p)) - ); "format_string", vfun2 (fun s p -> encode_expr ((get_api()).format_string (decode_string s) (decode_pos p)) ); @@ -1928,9 +1952,10 @@ let macro_api ccom get_api = ); "server_invalidate_files", vfun1 (fun a -> let cs = match CompilationServer.get() with Some cs -> cs | None -> failwith "compilation server not running" in + let com = ccom() in List.iter (fun v -> let s = decode_string v in - let s = Path.UniqueKey.create s in + let s = com.file_keys#get s in cs#taint_modules s; cs#remove_files s; ) (decode_array a); diff --git a/src/optimization/analyzer.ml b/src/optimization/analyzer.ml index a1e5495c..59b0008d 100644 --- a/src/optimization/analyzer.ml +++ b/src/optimization/analyzer.ml @@ -145,7 +145,7 @@ module Ssa = struct let v' = alloc_var v.v_kind v.v_name v.v_type v.v_pos in declare_var ctx.graph v' bb; v'.v_meta <- v.v_meta; - v'.v_capture <- v.v_capture; + if has_var_flag v VCaptured then add_var_flag v' VCaptured; add_var_def ctx.graph bb v'; set_reaching_def ctx.graph v' (get_reaching_def ctx.graph v); set_reaching_def ctx.graph v (Some v'); @@ -394,7 +394,7 @@ module ConstPropagation = DataFlow(struct | TTypeExpr mt -> ModuleType(mt,e.etype) | TLocal v -> - if (follow v.v_type) == t_dynamic || v.v_capture then + if (follow v.v_type) == t_dynamic || has_var_flag v VCaptured then Bottom else get_cell v.v_id @@ -486,7 +486,7 @@ module ConstPropagation = DataFlow(struct if not (type_change_ok ctx.com t e.etype) then raise Not_found; mk (TTypeExpr mt) t e.epos in - let is_special_var v = v.v_capture || ExtType.has_variable_semantics v.v_type in + let is_special_var v = has_var_flag v VCaptured || ExtType.has_variable_semantics v.v_type in let rec commit e = match e.eexpr with | TLocal v when not (is_special_var v) -> begin try @@ -527,11 +527,13 @@ module CopyPropagation = DataFlow(struct | Top | Bottom | Local of tvar + | This of Type.t let to_string = function | Top -> "Top" | Bottom -> "Bottom" | Local v -> Printf.sprintf "%s<%i>" v.v_name v.v_id + | This _ -> "this" let conditional = false let flag = FlagCopyPropagation @@ -547,12 +549,15 @@ module CopyPropagation = DataFlow(struct | Top,Top -> true | Bottom,Bottom -> true | Local v1,Local v2 -> v1.v_id = v2.v_id + | This t1,This t2 -> t1 == t2 | _ -> false let transfer ctx bb e = let rec loop e = match e.eexpr with - | TLocal v when not v.v_capture -> + | TLocal v when not (has_var_flag v VCaptured) -> Local v + | TConst TThis -> + This e.etype | TParenthesis e1 | TMeta(_,e1) | TCast(e1,None) -> loop e1 | _ -> @@ -565,25 +570,32 @@ module CopyPropagation = DataFlow(struct let commit ctx = let rec commit bb e = match e.eexpr with - | TLocal v when not v.v_capture -> + | TLocal v when not (has_var_flag v VCaptured) -> begin try let lat = get_cell v.v_id in let leave () = Hashtbl.remove lattice v.v_id; raise Not_found in - let v' = match lat with Local v -> v | _ -> leave() in - if not (type_change_ok ctx.com v'.v_type v.v_type) then leave(); - let v'' = get_var_origin ctx.graph v' in - (* This restriction is in place due to how we currently reconstruct the AST. Multiple SSA-vars may be turned back to - the same origin var, which creates interference that is not tracked in the analysis. We address this by only - considering variables whose origin-variables are assigned to at most once. *) - let writes = (get_var_info ctx.graph v'').vi_writes in - begin match writes with - | [bb'] when in_scope bb bb' -> () - | _ -> leave() + begin match lat with + | Local v' -> + if not (type_change_ok ctx.com v'.v_type v.v_type) then leave(); + let v'' = get_var_origin ctx.graph v' in + (* This restriction is in place due to how we currently reconstruct the AST. Multiple SSA-vars may be turned back to + the same origin var, which creates interference that is not tracked in the analysis. We address this by only + considering variables whose origin-variables are assigned to at most once. *) + let writes = (get_var_info ctx.graph v'').vi_writes in + begin match writes with + | [bb'] when in_scope bb bb' -> () + | _ -> leave() + end; + commit bb {e with eexpr = TLocal v'} + | This t -> + if not (type_change_ok ctx.com t v.v_type) then leave(); + mk (TConst TThis) t e.epos + | Top | Bottom -> + leave() end; - commit bb {e with eexpr = TLocal v'} with Not_found -> e end @@ -637,14 +649,14 @@ module LocalDce = struct let rec apply ctx = let is_used v = - Meta.has Meta.Used v.v_meta + has_var_flag v VUsed in let keep v = - is_used v || ((match v.v_kind with VUser _ | VInlined -> true | _ -> false) && not ctx.config.local_dce) || ExtType.has_reference_semantics v.v_type || v.v_capture || Meta.has Meta.This v.v_meta + is_used v || ((match v.v_kind with VUser _ | VInlined -> true | _ -> false) && not ctx.config.local_dce) || ExtType.has_reference_semantics v.v_type || has_var_flag v VCaptured || Meta.has Meta.This v.v_meta in let rec use v = if not (is_used v) then begin - v.v_meta <- (Meta.Used,[],null_pos) :: v.v_meta; + add_var_flag v VUsed; (try expr (get_var_value ctx.graph v) with Not_found -> ()); begin match Ssa.get_reaching_def ctx.graph v with | None -> use (get_var_origin ctx.graph v) diff --git a/src/optimization/analyzerTexpr.ml b/src/optimization/analyzerTexpr.ml index c36e17a2..2865f8fb 100644 --- a/src/optimization/analyzerTexpr.ml +++ b/src/optimization/analyzerTexpr.ml @@ -311,15 +311,15 @@ module InterferenceReport = struct (* vars *) | TLocal v -> set_var_read ir v; - if v.v_capture then set_state_read ir; + if has_var_flag v VCaptured then set_state_read ir; | TBinop(OpAssign,{eexpr = TLocal v},e2) -> set_var_write ir v; - if v.v_capture then set_state_write ir; + if has_var_flag v VCaptured then set_state_write ir; loop e2 | TBinop(OpAssignOp _,{eexpr = TLocal v},e2) -> set_var_read ir v; set_var_write ir v; - if v.v_capture then begin + if has_var_flag v VCaptured then begin set_state_read ir; set_state_write ir; end; @@ -589,7 +589,7 @@ module Fusion = struct let num_writes = state#get_writes v in let can_be_used_as_value = can_be_used_as_value com e in let is_compiler_generated = match v.v_kind with VUser _ | VInlined -> false | _ -> true in - let has_type_params = match v.v_extra with Some (tl,_) when tl <> [] -> true | _ -> false in + let has_type_params = match v.v_extra with Some ve when ve.v_params <> [] -> true | _ -> false in let b = num_uses <= 1 && num_writes = 0 && can_be_used_as_value && @@ -651,7 +651,7 @@ module Fusion = struct end | {eexpr = TVar(v1,Some e1)} :: el when config.optimize && config.local_dce && state#get_reads v1 = 0 && state#get_writes v1 = 0 -> fuse acc (e1 :: el) - | ({eexpr = TVar(v1,None)} as ev) :: el when not v1.v_capture -> + | ({eexpr = TVar(v1,None)} as ev) :: el when not (has_var_flag v1 VCaptured) -> let found = ref false in let rec replace deep e = match e.eexpr with | TBinop(OpAssign,{eexpr = TLocal v2},e2) when v1 == v2 -> @@ -748,7 +748,7 @@ module Fusion = struct found := true; if type_change_ok com v1.v_type e1.etype then e1 else mk (TCast(e1,None)) v1.v_type e.epos | TLocal v -> - if has_var_write ir v || ((v.v_capture || ExtType.has_reference_semantics v.v_type) && (has_state_write ir)) then raise Exit; + if has_var_write ir v || ((has_var_flag v VCaptured || ExtType.has_reference_semantics v.v_type) && (has_state_write ir)) then raise Exit; e | TBinop(OpAssign,({eexpr = TLocal v} as e1),e2) -> let e2 = replace e2 in @@ -1179,7 +1179,7 @@ module Purity = struct apply_to_class com c with Purity_conflict(impure,p) -> com.error "Impure field overrides/implements field which was explicitly marked as @:pure" impure.pn_field.cf_pos; - Error.error "Pure field is here" p; + Error.error (Error.compl_msg "Pure field is here") p; end | _ -> () ) com.types; diff --git a/src/optimization/analyzerTexprTransformer.ml b/src/optimization/analyzerTexprTransformer.ml index ccc7f58d..df949403 100644 --- a/src/optimization/analyzerTexprTransformer.ml +++ b/src/optimization/analyzerTexprTransformer.ml @@ -83,7 +83,7 @@ let rec func ctx bb tf t p = in let check_unbound_call s el = if s = "$ref" then begin match el with - | [{eexpr = TLocal v}] -> v.v_capture <- true + | [{eexpr = TLocal v}] -> add_var_flag v VCaptured | _ -> () end; if is_unbound_call_that_might_have_side_effects s el then ctx.has_unbound <- true; @@ -202,8 +202,12 @@ let rec func ctx bb tf t p = end ) (false,[]) (List.rev el) in let bb,values = List.fold_left (fun (bb,acc) (aff,opt,e) -> - let bb,value = if aff || opt then bind_to_temp bb aff e else value bb e in - bb,(value :: acc) + if bb == g.g_unreachable then + bb,acc + else begin + let bb,value = if aff || opt then bind_to_temp bb aff e else value bb e in + bb,(value :: acc) + end ) (bb,[]) el in bb,List.rev values and bind_to_temp ?(v=None) bb sequential e = @@ -304,7 +308,7 @@ let rec func ctx bb tf t p = let bb = ref bb in let check e t = match e.eexpr with | TLocal v when ExtType.has_reference_semantics t -> - v.v_capture <- true; + add_var_flag v VCaptured; e | _ -> if ExtType.has_variable_semantics t then begin @@ -733,7 +737,7 @@ and func ctx i = false in begin match e1.eexpr,e2.eexpr with - | TLocal v1,TLocal v2 when v1 == v2 && not v1.v_capture && is_valid_assign_op op -> + | TLocal v1,TLocal v2 when v1 == v2 && not (has_var_flag v1 VCaptured) && is_valid_assign_op op -> begin match op,e3.eexpr with | (OpAdd|OpSub) as op,TConst (TInt i32) when Int32.to_int i32 = 1 && ExtType.is_numeric (Abstract.follow_with_abstracts v1.v_type) -> let op = match op with diff --git a/src/optimization/analyzerTypes.ml b/src/optimization/analyzerTypes.ml index ed2df6f4..1b1fc998 100644 --- a/src/optimization/analyzerTypes.ml +++ b/src/optimization/analyzerTypes.ml @@ -176,7 +176,7 @@ module Graph = struct type var_info = { vi_var : tvar; (* The variable itself *) - vi_extra : tvar_extra; (* The original v_extra *) + vi_extra : tvar_extra option; (* The original v_extra *) vi_bb_declare : BasicBlock.t; (* The block where this variable was declared *) mutable vi_origin : tvar; (* The origin variable of this variable *) mutable vi_writes : var_write; (* A list of blocks that assign to this variable *) @@ -210,11 +210,11 @@ module Graph = struct } in DynArray.add g.g_var_infos vi; let i = DynArray.length g.g_var_infos - 1 in - v.v_extra <- Some([],Some (mk (TConst (TInt (Int32.of_int i))) t_dynamic null_pos)); + v.v_extra <- Some(var_extra [] (Some (mk (TConst (TInt (Int32.of_int i))) t_dynamic null_pos))); vi let get_var_info g v = match v.v_extra with - | Some(_,Some {eexpr = TConst (TInt i32)}) -> DynArray.get g.g_var_infos (Int32.to_int i32) + | Some({v_expr = Some {eexpr = TConst (TInt i32)}}) -> DynArray.get g.g_var_infos (Int32.to_int i32) | _ -> print_endline "Unbound variable, please report this"; print_endline (Printer.s_tvar v); diff --git a/src/optimization/dce.ml b/src/optimization/dce.ml index e199f038..76fec5bc 100644 --- a/src/optimization/dce.ml +++ b/src/optimization/dce.ml @@ -59,7 +59,7 @@ let rec super_forces_keep c = | _ -> false let overrides_extern_field cf c = - let is_extern c cf = c.cl_extern && cf.cf_expr = None in + let is_extern c cf = (has_class_flag c CExtern) && cf.cf_expr = None in let rec loop c cf = match c.cl_super with | None -> false @@ -83,19 +83,19 @@ let keep_metas = [Meta.Keep;Meta.Expose] (* check if a class is kept entirely *) let keep_whole_class dce c = Meta.has_one_of keep_metas c.cl_meta - || not (dce.full || is_std_file dce c.cl_module.m_extra.m_file || has_meta Meta.Dce c.cl_meta) + || not (dce.full || is_std_file dce (Path.UniqueKey.lazy_path c.cl_module.m_extra.m_file) || has_meta Meta.Dce c.cl_meta) || super_forces_keep c || (match c with | { cl_path = ([],("Math"|"Array"))} when dce.com.platform = Js -> false - | { cl_extern = true } | { cl_path = ["flash";"_Boot"],"RealBoot" } -> true + | _ when (has_class_flag c CExtern) -> true | { cl_path = [],"String" } | { cl_path = [],"Array" } -> not (dce.com.platform = Js) | _ -> false) let keep_whole_enum dce en = Meta.has_one_of keep_metas en.e_meta - || not (dce.full || is_std_file dce en.e_module.m_extra.m_file || has_meta Meta.Dce en.e_meta) + || not (dce.full || is_std_file dce (Path.UniqueKey.lazy_path en.e_module.m_extra.m_file) || has_meta Meta.Dce en.e_meta) let mk_used_meta pos = Meta.Used,[],(mk_zero_range_pos pos) @@ -273,7 +273,7 @@ let rec mark_dependent_fields dce csup n stat = let cf = PMap.find n (if stat then c.cl_statics else c.cl_fields) in (* if it's clear that the class is kept, the field has to be kept as well. This is also true for extern interfaces because we cannot remove fields from them *) - if Meta.has Meta.Used c.cl_meta || (csup.cl_interface && csup.cl_extern) then mark_field dce c cf stat + if Meta.has Meta.Used c.cl_meta || ((has_class_flag csup CInterface) && (has_class_flag csup CExtern)) then mark_field dce c cf stat (* otherwise it might be kept if the class is kept later, so mark it as :?used *) else if not (Meta.has Meta.MaybeUsed cf.cf_meta) then begin cf.cf_meta <- (Meta.MaybeUsed,[],cf.cf_pos) :: cf.cf_meta; @@ -332,7 +332,7 @@ and field dce c n stat = let cf = find_field n in mark_field dce c cf stat; with Not_found -> try - if c.cl_interface then begin + if (has_class_flag c CInterface) then begin let rec loop cl = match cl with | [] -> raise Not_found | (c,_) :: cl -> @@ -627,10 +627,18 @@ and expr dce e = check_and_add_feature dce "dynamic_binop_=="; expr dce e1; expr dce e2; + | TBinop(OpEq,({ etype = t1} as e1), ({ etype = t2} as e2) ) when ExtType.is_type_param (follow t1) || ExtType.is_type_param (follow t2) -> + check_and_add_feature dce "type_param_binop_=="; + expr dce e1; + expr dce e2; | TBinop(OpNotEq,({ etype = t1} as e1), ({ etype = t2} as e2) ) when is_dynamic t1 || is_dynamic t2 -> check_and_add_feature dce "dynamic_binop_!="; expr dce e1; expr dce e2; + | TBinop(OpNotEq,({ etype = t1} as e1), ({ etype = t2} as e2) ) when ExtType.is_type_param (follow t1) || ExtType.is_type_param (follow t2) -> + check_and_add_feature dce "type_param_binop_!="; + expr dce e1; + expr dce e2; | TBinop(OpMod,e1,e2) -> check_and_add_feature dce "binop_%"; expr dce e1; @@ -660,14 +668,14 @@ let fix_accessors com = List.iter (fun mt -> match mt with (* filter empty abstract implementation classes (issue #1885). *) | TClassDecl({cl_kind = KAbstractImpl _} as c) when c.cl_ordered_statics = [] && c.cl_ordered_fields = [] && not (Meta.has Meta.Used c.cl_meta) -> - c.cl_extern <- true - | TClassDecl({cl_kind = KAbstractImpl a} as c) when Meta.has Meta.Enum a.a_meta -> + add_class_flag c CExtern; + | TClassDecl({cl_kind = KAbstractImpl a} as c) when a.a_enum -> let is_runtime_field cf = - not (Meta.has Meta.Enum cf.cf_meta) + not (has_class_field_flag cf CfEnum) in (* also filter abstract implementation classes that have only @:enum fields (issue #2858) *) if not (List.exists is_runtime_field c.cl_ordered_statics) then - c.cl_extern <- true + add_class_flag c CExtern | (TClassDecl c) -> let rec has_accessor c n stat = PMap.mem n (if stat then c.cl_statics else c.cl_fields) @@ -696,7 +704,7 @@ let collect_entry_points dce com = mt.mt_meta <- Meta.remove Meta.Used mt.mt_meta; match t with | TClassDecl c -> - let keep_class = keep_whole_class dce c && (not c.cl_extern || c.cl_interface) in + let keep_class = keep_whole_class dce c && (not (has_class_flag c CExtern) || (has_class_flag c CInterface)) in let loop stat cf = if keep_class || keep_field dce cf c stat then mark_field dce c cf stat in @@ -747,10 +755,12 @@ let mark dce = ) cfl; (* follow expressions to new types/fields *) List.iter (fun (c,cf,_) -> - let pop = push_class dce c in - opt (expr dce) cf.cf_expr; - List.iter (fun cf -> if cf.cf_expr <> None then opt (expr dce) cf.cf_expr) cf.cf_overloads; - pop(); + if not (has_class_flag c CExtern) then begin + let pop = push_class dce c in + opt (expr dce) cf.cf_expr; + List.iter (fun cf -> if cf.cf_expr <> None then opt (expr dce) cf.cf_expr) cf.cf_overloads; + pop() + end ) cfl; loop () in @@ -815,7 +825,7 @@ let sweep dce com = (match c.cl_init with | Some f when Meta.has Meta.KeepInit c.cl_meta -> (* it means that we only need the __init__ block *) - c.cl_extern <- true; + add_class_flag c CExtern; loop (mt :: acc) l | _ -> if dce.debug then print_endline ("[DCE] Removed class " ^ (s_type_path c.cl_path)); @@ -850,12 +860,6 @@ let run com main mode = features = Hashtbl.create 0; curclass = null_class; } in - begin match main with - | Some {eexpr = TCall({eexpr = TField(e,(FStatic(c,cf)))},_)} | Some {eexpr = TBlock ({ eexpr = TCall({eexpr = TField(e,(FStatic(c,cf)))},_)} :: _)} -> - cf.cf_meta <- (mk_keep_meta cf.cf_pos) :: cf.cf_meta - | _ -> - () - end; List.iter (fun m -> List.iter (fun (s,v) -> if Hashtbl.mem dce.features s then Hashtbl.replace dce.features s (v :: Hashtbl.find dce.features s) @@ -878,15 +882,18 @@ let run com main mode = (* remove "override" from fields that do not override anything anymore *) List.iter (fun mt -> match mt with | TClassDecl c -> - c.cl_overrides <- List.filter (fun s -> - let rec loop c = - match c.cl_super with - | Some (csup,_) when PMap.mem s.cf_name csup.cl_fields -> true - | Some (csup,_) -> loop csup - | None -> false - in - loop c - ) c.cl_overrides; + List.iter (fun cf -> + if has_class_field_flag cf CfOverride then begin + let rec loop c = + match c.cl_super with + | Some (csup,_) when PMap.mem cf.cf_name csup.cl_fields -> true + | Some (csup,_) -> loop csup + | None -> false + in + let b = loop c in + if not b then remove_class_field_flag cf CfOverride; + end + ) c.cl_ordered_fields; | _ -> () ) com.types; @@ -894,10 +901,10 @@ let run com main mode = Mark extern classes as really used if they are extended by non-extern ones. *) List.iter (function - | TClassDecl ({cl_extern = false; cl_super = Some ({cl_extern = true} as csup, _)}) -> + | TClassDecl ({cl_super = Some (csup, _)} as c) when not (has_class_flag c CExtern) && (has_class_flag csup CExtern) -> mark_directly_used_class dce csup - | TClassDecl ({cl_extern = false} as c) when c.cl_implements <> [] -> - List.iter (fun (iface,_) -> if (iface.cl_extern) then mark_directly_used_class dce iface) c.cl_implements; + | TClassDecl c when not (has_class_flag c CExtern) && c.cl_implements <> [] -> + List.iter (fun (iface,_) -> if ((has_class_flag iface CExtern)) then mark_directly_used_class dce iface) c.cl_implements; | _ -> () ) com.types; diff --git a/src/optimization/inline.ml b/src/optimization/inline.ml index 50746b1e..6a889e22 100644 --- a/src/optimization/inline.ml +++ b/src/optimization/inline.ml @@ -6,6 +6,10 @@ open Common open Typecore open Error +let needs_inline ctx is_extern_class cf = + cf.cf_kind = Method MethInline + && (ctx.g.doinline || is_extern_class || has_class_field_flag cf CfExtern) + let mk_untyped_call name p params = { eexpr = TCall({ eexpr = TIdent name; etype = t_dynamic; epos = p }, params); @@ -110,10 +114,10 @@ let api_inline ctx c field params p = let mk_typeexpr path = let m = (try Hashtbl.find ctx.g.modules path with Not_found -> die "" __LOC__) in add_dependency ctx.m.curmod m; - ExtList.List.find_map (function + Option.get (ExtList.List.find_map (function | TClassDecl cl when cl.cl_path = path -> Some (make_static_this cl p) | _ -> None - ) m.m_types + ) m.m_types) in let eJsSyntax () = mk_typeexpr (["js"],"Syntax") in @@ -163,14 +167,14 @@ let api_inline ctx c field params p = Some (mk (TBinop (Ast.OpBoolAnd, iof, not_enum)) tbool p) end | TTypeExpr (TClassDecl cls) -> - if cls.cl_interface then + if (has_class_flag cls CInterface) then Some (Texpr.Builder.fcall (eJsBoot()) "__implements" [o;t] tbool p) else Some (Texpr.Builder.fcall (eJsSyntax()) "instanceof" [o;t] tbool p) | _ -> None) | (["js"],"Boot"),"__downcastCheck",[o; {eexpr = TTypeExpr (TClassDecl cls) } as t] when ctx.com.platform = Js -> - if cls.cl_interface then + if (has_class_flag cls CInterface) then Some (Texpr.Builder.fcall (make_static_this c p) "__implements" [o;t] tbool p) else Some (Texpr.Builder.fcall (eJsSyntax()) "instanceof" [o;t] tbool p) @@ -246,7 +250,7 @@ let inline_default_config cf t = let inline_config cls_opt cf call_args return_type = match cls_opt with - | Some ({cl_kind = KAbstractImpl _}) when Meta.has Meta.Impl cf.cf_meta -> + | Some ({cl_kind = KAbstractImpl _}) when has_class_field_flag cf CfImpl -> let t = if cf.cf_name = "_new" then return_type else if call_args = [] then @@ -450,7 +454,7 @@ class inline_state ctx ethis params cf f p = object(self) l.i_force_temp <- true; end; (* We use a null expression because we only care about the type (for abstract casts). *) - if l.i_abstract_this then l.i_subst.v_extra <- Some ([],Some {e with eexpr = TConst TNull}); + if l.i_abstract_this then l.i_subst.v_extra <- Some (var_extra [] (Some {e with eexpr = TConst TNull})); loop ((l,e) :: acc) pl al false | [], (v,opt) :: al -> let l = self#declare v in @@ -583,7 +587,7 @@ class inline_state ctx ethis params cf f p = object(self) let unify_func () = unify_raise ctx mt (TFun (tl,tret)) p in (match follow ethis.etype with | TAnon a -> (match !(a.a_status) with - | Statics {cl_kind = KAbstractImpl a } when Meta.has Meta.Impl cf.cf_meta -> + | Statics {cl_kind = KAbstractImpl a } when has_class_field_flag cf CfImpl -> if cf.cf_name <> "_new" then begin (* the first argument must unify with a_this for abstract implementation functions *) let tb = (TFun(("",false,map_type a.a_this) :: (List.tl tl),tret)) in @@ -599,8 +603,8 @@ class inline_state ctx ethis params cf f p = object(self) if not (self#read v).i_outside then begin v.v_type <- map_type v.v_type; match v.v_extra with - | Some(tl,Some e) -> - v.v_extra <- Some(tl,Some (map_expr_type map_type e)); + | Some ({v_expr = Some e} as ve) -> + v.v_extra <- Some(var_extra ve.v_params (Some (map_expr_type map_type e))); | _ -> () end @@ -615,7 +619,8 @@ class inline_state ctx ethis params cf f p = object(self) if List.memq e params then (fun t -> t) else map_type in - Type.map_expr_type (map_expr_type map_type) map_type (map_var map_type) e + let e = Type.map_expr_type (map_expr_type map_type) map_type (map_var map_type) e in + CallUnification.maybe_reapply_overload_call ctx e in let e = map_expr_type map_type e in let rec drop_unused_vars e = @@ -645,6 +650,7 @@ let rec type_inline ctx cf f ethis params tret config p ?(self_calling_closure=f | None -> raise Exit | Some e -> Some e) with Exit -> + let params = inline_rest_params ctx f params p in let state = new inline_state ctx ethis params cf f p in let vthis_opt = state#initialize in let opt f = function @@ -688,7 +694,13 @@ let rec type_inline ctx cf f ethis params tret config p ?(self_calling_closure=f | TVar (v,eo) -> { e with eexpr = TVar ((state#declare v).i_subst,opt (map false false) eo)} | TReturn eo when not state#in_local_fun -> - if not term then error "Cannot inline a not final return" po; + if not term then begin + match cf.cf_kind with + | Method MethInline -> + error "Cannot inline a not final return" po + | _ -> + error ("Function " ^ cf.cf_name ^ " cannot be inlined because of a not final return") p + end; (match eo with | None -> mk (TConst TNull) f.tf_type p | Some e -> @@ -871,3 +883,38 @@ and type_inline_ctor ctx c cf tf ethis el po = {tf with tf_expr = mk (TBlock (field_inits @ bl)) ctx.t.tvoid c.cl_pos} in type_inline ctx cf tf ethis el ctx.t.tvoid None po true + +and inline_rest_params ctx f params p = + if not ctx.com.config.pf_supports_rest_args then + params + else + let rec loop args params = + match args, params with + (* last argument expects rest parameters *) + | [(v,_)], params when ExtType.is_rest (follow v.v_type) -> + (match params with + (* In case of `...rest` just use `rest` *) + | [{ eexpr = TUnop(Spread,Prefix,e) }] -> [e] + (* In other cases: `haxe.Rest.of([param1, param2, ...])` *) + | _ -> + match follow v.v_type with + | TAbstract ({ a_path = ["haxe"],"Rest"; a_impl = Some c } as a, [t]) as rest_t -> + let cf = + try PMap.find "of" c.cl_statics + with Not_found -> die ~p:c.cl_name_pos "Can't find haxe.Rest.of function" __LOC__ + and p = punion_el (List.map (fun e -> (),e.epos) params) in + (* [param1, param2, ...] *) + let array = mk (TArrayDecl params) (ctx.t.tarray t) p in + (* haxe.Rest.of(array) *) + [make_static_call ctx c cf (apply_params a.a_params [t]) [array] rest_t p] + | _ -> + die ~p:v.v_pos "Unexpected rest arguments type" __LOC__ + ) + | a :: args, e :: params -> + e :: loop args params + | [], params -> + params + | _ :: _, [] -> + [] + in + loop f.tf_args params diff --git a/src/optimization/inlineConstructors.ml b/src/optimization/inlineConstructors.ml index 4f623ae6..6db7247d 100644 --- a/src/optimization/inlineConstructors.ml +++ b/src/optimization/inlineConstructors.ml @@ -29,8 +29,7 @@ open Globals (* First pass: Finds all inline objects and variables that alias them. - Inline objects reference instances of TNew TObjectDecl and TArrayDecl, identified a number - assigned by order of appearance in the expression. + Inline objects reference instances of TNew TObjectDecl and TArrayDecl. When an inline object is assigned to a variable, this variable is considered an alias of it. If an aliasing variable is assigned more than once then inlining will be cancelled for the inline object the variable would have aliased. @@ -42,48 +41,73 @@ open Globals inlining. Second pass: - Replace variables that alias inline objects with their respective field inline variables. - Identify inline objects by order of appearance and replace them with their inlined constructor expressions. - Replace field access of aliasing variables with the respective field inline variable. + Replaces inline objects with their inlined constructor expressions. + Replaces field access of aliasing variables with the respective field inline variable or inlined methods. Because some replacements turn a single expression into many, this pass will map texpr into texpr list, which is converted into TBlocks by the caller as needed. *) -type inline_object_kind = - | IOKCtor of tclass_field * bool * tvar list +type inline_object_ctor = { + ioc_class : Type.tclass; + ioc_tparams : Type.tparams; + ioc_field : Type.tclass_field; + ioc_forced : bool; (* Cancelling a forced constructor should produce an error *) +} + +and inline_object_kind = + | IOKCtor of inline_object_ctor | IOKStructure | IOKArray of int +(* + inline_object + Represents an instance of TNew TObjectDecl or TArrayDecl that has potential to be inlined. + Wether the inlining is cancelled or not is decided during the analysis phase. +*) and inline_object = { io_kind : inline_object_kind; - io_expr : texpr; - io_pos : pos; - io_has_untyped : bool; - mutable io_cancelled : bool; - mutable io_declared : bool; - mutable io_aliases : inline_var list; - mutable io_fields : (string,inline_var) PMap.t; - mutable io_id_start : int; - mutable io_id_end : int; + io_expr : texpr; (* This is the inlined constructor expression *) + io_pos : pos; (* The original position of the constructor expression *) + mutable io_has_untyped : bool; (* Wether inlining this object would bring untyped expressions into the parent expression *) + mutable io_cancelled : bool; (* Wether this inline object has been cancelled *) + mutable io_declared : bool; (* Wether the variable declarations for this inline object's fields have already been output. (Used in final_map) *) + mutable io_aliases : inline_var list; (* List of variables that are aliasing/referencing this inline object *) + mutable io_fields : (string,inline_var) PMap.t; (* The fields that this inline object supports, fields are inline variables which might alias other inline_objects *) + mutable io_inline_methods : texpr list; (* List of inlined method calls. Populated during analysis and consumed by the final_map phase *) + mutable io_dependent_vars : tvar list; (* List of variables that should be cancelled if this inline object is cancelled *) } and inline_var_kind = - | IVKField of inline_object * string * texpr option + | IVKField of + inline_object * + string * (* The field name *) + texpr option (* If this is Some _ then this field is a constant. (Used for Array .length property) *) | IVKLocal and inline_var_state = - | IVSUnassigned - | IVSAliasing of inline_object - | IVSCancelled + | IVSUnassigned (* The variable isn't yet assigned *) + | IVSAliasing of inline_object (* The variable is aliasing an inline object *) + | IVSCancelled (* The variable was cancelled and should no longer be considered for aliasing inline objects *) +(* + inline_var + Represents a local variable that is tracked by the inline constructor analysis. + It's main purpose is to track variables that are considered aliases of inline objects. + It also tracks all unassigned variables in the program. +*) and inline_var = { iv_var : tvar; mutable iv_state : inline_var_state; mutable iv_kind : inline_var_kind; - mutable iv_closed : bool + mutable iv_closed : bool (* Inline variables are marked as closed when the scope they were first assigned on ends, any appearance of this variable after it has been closed causes cancellation *) } -let inline_constructors ctx e = +and inline_object_field = + | IOFInlineMethod of inline_object * inline_var * tclass * Type.tparams * tclass_field * tfunc + | IOFInlineVar of inline_var + | IOFNone + +let inline_constructors ctx original_e = let inline_objs = ref IntMap.empty in let vars = ref IntMap.empty in let scoped_ivs = ref [] in @@ -95,11 +119,11 @@ let inline_constructors ctx e = List.iter (fun iv -> cancel_iv iv p) io.io_aliases; PMap.iter (fun _ iv -> cancel_iv iv p) io.io_fields; match io.io_kind with - | IOKCtor(_,isextern,vars) -> - List.iter (fun v -> if v.v_id < 0 then cancel_v v p) vars; - if isextern then begin + | IOKCtor(ioc) -> + List.iter (fun v -> if v.v_id < 0 then cancel_v v p) io.io_dependent_vars; + if ioc.ioc_forced then begin display_error ctx "Forced inline constructor could not be inlined" io.io_pos; - display_error ctx "Cancellation happened here" p; + display_error ctx (compl_msg "Cancellation happened here") p; end | _ -> () end @@ -165,32 +189,88 @@ let inline_constructors ctx e = if i < 0 then "n" ^ (string_of_int (-i)) else (string_of_int i) in - let is_extern_ctor c cf = c.cl_extern || has_class_field_flag cf CfExtern in + let is_extern_ctor c cf = (has_class_flag c CExtern) || has_class_field_flag cf CfExtern in let make_expr_for_list (el:texpr list) (t:t) (p:pos): texpr = match el with | [] -> mk (TBlock[]) ctx.t.tvoid p | [e] -> e | _ -> mk (TBlock (el)) t p in let make_expr_for_rev_list (el:texpr list) (t:t) (p:pos) : texpr = make_expr_for_list (List.rev el) t p in - let current_io_id = ref 0 in - let increment_io_id e = match e.eexpr with - | TObjectDecl _ | TArrayDecl _ | TNew _ | (TMeta((Meta.Inline,_,_),{eexpr = TNew _})) -> incr current_io_id - | _ -> () + let curr_io_id = ref 0 in + + (* + check_for_ctors + Returns true if there are any potential inline objects in the expression. + It is used to save work before running mark_ctors and analyze_aliases. + *) + let rec check_for_ctors ?(force_inline=false) e = + let is_ctor, is_meta_inline = match e.eexpr, force_inline with + | TMeta((Meta.Inline,_,_),_), _ -> + false, true + | TObjectDecl _, _ + | TArrayDecl _, _ + | TNew _, true -> + true, false + | TNew({ cl_constructor = Some ({cf_kind = Method MethInline; cf_expr = Some ({eexpr = TFunction _})} as cf)} as c,_,_), _ -> + Inline.needs_inline ctx (has_class_flag c CExtern) cf, false + | _ -> false, false + in + is_ctor || Type.check_expr (check_for_ctors ~force_inline:is_meta_inline) e in + (* + mark_ctors + Finds all instances of potential inline objects in an expression and wraps them with metadata @:inlineObject(id). + The id is incremented each time and is used later in the final_map phase to identify the correct inline_object. + *) + let rec mark_ctors ?(force_inline=false) e : texpr = + let is_meta_inline = match e.eexpr with (TMeta((Meta.Inline,_,_),e)) -> true | _ -> false in + let e = Type.map_expr (mark_ctors ~force_inline:is_meta_inline) e in + let mark() = + incr curr_io_id; + let id_expr = (EConst(Int (string_of_int !curr_io_id)), e.epos) in + let meta = (Meta.InlineObject, [id_expr], e.epos) in + mk (TMeta(meta, e)) e.etype e.epos + in + match e.eexpr, force_inline with + | TObjectDecl _, _ + | TArrayDecl _, _ + | TNew _, true -> + mark() + | TNew({ cl_constructor = Some ({cf_kind = Method MethInline; cf_expr = Some ({eexpr = TFunction _})} as cf)} as c,_,_), _ -> + if Inline.needs_inline ctx (has_class_flag c CExtern) cf then mark() + else e + | _ -> e + in + + (* + analyze_aliases is the main work-horse of the constructor inliner analysis. + It runs recursively over all expressions, it must do so in code execution order. + The expression being analyzed should have been processed with mark_ctors before hand. + + returns: Some(inline variable) if the expression being analyzed returns an inline variable. None otherwise. + + seen_ctors: used to avoid infinite constructor inlining loops. + + captured: Wether the caller is ready to accept an inline variable. If analysis results in an inline + variable and this argument is false then the inline variable must be cancelled before returning. + + is_lvalue: Wether the expression being analyzed is on the left side of an assignment. + + e: The expression to analyze + *) let rec analyze_aliases (seen_ctors:tclass_field list) (captured:bool) (is_lvalue:bool) (e:texpr) : inline_var option = - increment_io_id e; let mk_io ?(has_untyped=false) (iok : inline_object_kind) (id:int) (expr:texpr) : inline_object = let io = { io_kind = iok; io_expr = expr; - io_pos = e.epos; + io_pos = expr.epos; io_cancelled = false; io_declared = false; io_fields = PMap.empty; io_aliases = []; - io_id_start = id; - io_id_end = id; io_has_untyped = has_untyped; + io_inline_methods = []; + io_dependent_vars = []; } in inline_objs := IntMap.add id io !inline_objs; io @@ -198,117 +278,171 @@ let inline_constructors ctx e = let analyze_aliases_in_lvalue e = analyze_aliases seen_ctors captured true e in let analyze_aliases_in_ctor cf captured e = analyze_aliases (cf::seen_ctors) captured false e in let analyze_aliases captured e = analyze_aliases seen_ctors captured false e in - let handle_field_case te fname validate_io = - begin match analyze_aliases true te with - | Some({iv_state = IVSAliasing io} as iv) when validate_io io -> + let get_io_inline_method io fname = + begin match io.io_kind with + | IOKCtor(ctor) -> begin try - let fiv = get_io_field io fname in - if not (type_iseq_strict fiv.iv_var.v_type e.etype) then raise Not_found; - let iv_is_const iv = match iv.iv_kind with IVKField(_,_,Some(_)) -> true | _ -> false in - if is_lvalue && iv_is_const fiv then raise Not_found; - if fiv.iv_closed then raise Not_found; - if not captured || (not is_lvalue && fiv.iv_state == IVSUnassigned) then cancel_iv fiv e.epos; - Some(fiv) - with Not_found -> - cancel_iv iv e.epos; - None + let f = PMap.find fname ctor.ioc_class.cl_fields in + begin match f.cf_params, f.cf_kind, f.cf_expr with + | [], Method MethInline, Some({eexpr = TFunction tf}) -> + if Inline.needs_inline ctx (has_class_flag ctor.ioc_class CExtern) f then + Some (ctor.ioc_class, ctor.ioc_tparams, f, tf) + else + None + | _ -> None + end + with Not_found -> None end - | Some(iv) -> - cancel_iv iv e.epos; - None | _ -> None end in - match e.eexpr, e.etype with - | TNew({ cl_constructor = Some ({cf_kind = Method MethInline; cf_expr = Some ({eexpr = TFunction tf})} as cf)} as c,tl,pl),_ - | TMeta((Meta.Inline,_,_),{eexpr = TNew({ cl_constructor = Some ({cf_expr = Some ({eexpr = TFunction tf})} as cf)} as c,tl,pl)}),_ - when captured && not (List.memq cf seen_ctors) -> - begin - let io_id = !current_io_id in - let rec loop (vs, decls, es) el = match el with - | e :: el -> - begin match e.eexpr with - | TConst _ -> loop (vs, decls, e::es) el - | _ -> - let v = alloc_var VGenerated "arg" e.etype e.epos in - let decle = mk (TVar(v, Some e)) ctx.t.tvoid e.epos in - let io_id_start = !current_io_id in - ignore(analyze_aliases true decle); - let mde = (Meta.InlineConstructorArgument (v.v_id, io_id_start)), [], e.epos in - let e = mk (TMeta(mde, e)) e.etype e.epos in - loop (v::vs, decle::decls, e::es) el - end - | [] -> vs, (List.rev decls), (List.rev es) - in - let argvs, argvdecls, pl = loop ([],[],[]) pl in - let _, cname = c.cl_path in - let v = alloc_var VGenerated ("inl"^cname) e.etype e.epos in - match Inline.type_inline_ctor ctx c cf tf (mk (TLocal v) (TInst (c,tl)) e.epos) pl e.epos with - | Some inlined_expr -> - let has_untyped = (Meta.has Meta.HasUntyped cf.cf_meta) in - let forced = is_extern_ctor c cf || (match e.eexpr with TMeta _ -> true | _ -> false) in - let io = mk_io (IOKCtor(cf,forced,argvs)) io_id inlined_expr ~has_untyped:has_untyped in - let rec loop (c:tclass) (tl:t list) = - let apply = apply_params c.cl_params tl in - List.iter (fun cf -> - match cf.cf_kind,cf.cf_expr with - | Var _, _ -> - let fieldt = apply cf.cf_type in - ignore(alloc_io_field io cf.cf_name fieldt v.v_pos); - | _ -> () - ) c.cl_ordered_fields; - match c.cl_super with - | Some (c,tl) -> loop c (List.map apply tl) - | None -> () - in loop c tl; - let iv = add v IVKLocal in - set_iv_alias iv io; - io.io_id_start <- !current_io_id; - ignore(analyze_aliases_in_ctor cf true io.io_expr); - io.io_id_end <- !current_io_id; - Some iv - | _ -> - List.iter (fun v -> cancel_v v v.v_pos) argvs; - if is_extern_ctor c cf then display_error ctx "Extern constructor could not be inlined" e.epos; - None + let handle_field_case ?(captured=false) ?(is_lvalue=false) efield ethis fname validate_io : inline_object_field = + begin match analyze_aliases true ethis with + | Some({iv_state = IVSAliasing io} as iv) when validate_io io -> + begin match get_io_inline_method io fname with + | Some(c, tl, cf, tf)-> + let method_type = apply_params c.cl_params tl cf.cf_type in + let field_is_function = match efield.etype with | TFun _ -> true | _ -> false in + if field_is_function && Type.does_unify method_type efield.etype then + IOFInlineMethod(io,iv,c,tl,cf,tf) + else begin + cancel_iv iv efield.epos; + IOFNone + end + | None -> + begin try + let fiv = get_io_field io fname in + if not (type_iseq_strict fiv.iv_var.v_type efield.etype) then raise Not_found; + let iv_is_const iv = match iv.iv_kind with IVKField(_,_,Some(_)) -> true | _ -> false in + if is_lvalue && iv_is_const fiv then raise Not_found; + if fiv.iv_closed then raise Not_found; + if not captured || (not is_lvalue && fiv.iv_state == IVSUnassigned) then cancel_iv fiv efield.epos; + IOFInlineVar(fiv) + with Not_found -> + cancel_iv iv efield.epos; + IOFNone + end + end + | Some(iv) -> + cancel_iv iv efield.epos; + IOFNone + | _ -> + IOFNone end - | TNew({ cl_constructor = Some ({cf_kind = Method MethInline; cf_expr = Some _} as cf)} as c,_,pl),_ when is_extern_ctor c cf -> - error "Extern constructor could not be inlined" e.epos; - | TObjectDecl fl, _ when captured && fl <> [] && List.for_all (fun((s,_,_),_) -> Lexer.is_valid_identifier s) fl -> - let v = alloc_var VGenerated "inlobj" e.etype e.epos in - let ev = mk (TLocal v) v.v_type e.epos in - let el = List.map (fun ((s,_,_),e) -> - let ef = mk (TField(ev,FDynamic s)) e.etype e.epos in - let e = mk (TBinop(OpAssign,ef,e)) e.etype e.epos in - e - ) fl in - let io_expr = make_expr_for_list el ctx.t.tvoid e.epos in - let io = mk_io (IOKStructure) !current_io_id io_expr in - List.iter (fun ((s,_,_),e) -> ignore(alloc_io_field io s e.etype v.v_pos)) fl; - let iv = add v IVKLocal in - set_iv_alias iv io; - List.iter (fun e -> ignore(analyze_aliases true e)) el; - io.io_id_end <- !current_io_id; - Some iv - | TArrayDecl el, TInst(_, [elemtype]) when captured -> - let len = List.length el in - let v = alloc_var VGenerated "inlarr" e.etype e.epos in - let ev = mk (TLocal v) v.v_type e.epos in - let el = List.mapi (fun i e -> - let ef = mk (TArray(ev,(mk (TConst(TInt (Int32.of_int i))) e.etype e.epos))) elemtype e.epos in - mk (TBinop(OpAssign,ef,e)) elemtype e.epos - ) el in - let io_expr = make_expr_for_list el ctx.t.tvoid e.epos in - let io = mk_io (IOKArray(len)) !current_io_id io_expr in - ignore(alloc_const_io_field io "length" (mk (TConst(TInt (Int32.of_int len))) ctx.t.tint e.epos)); - for i = 0 to len-1 do ignore(alloc_io_field io (int_field_name i) elemtype v.v_pos) done; - let iv = add v IVKLocal in - set_iv_alias iv io; - List.iter (fun e -> ignore(analyze_aliases true e)) el; - io.io_id_end <- !current_io_id; - Some iv - | TVar(v,None),_ -> ignore(add v IVKLocal); None - | TVar(v,Some rve),_ -> + in + let handle_field_case_no_methods efield ethis fname validate_io = match handle_field_case ~captured:captured ~is_lvalue:is_lvalue efield ethis fname validate_io with + | IOFInlineMethod(io,_,_,_,_,_) -> cancel_io io efield.epos; None + | IOFInlineVar(iv) -> Some(iv) + | IOFNone -> None + in + let handle_default_case e = + let old = !scoped_ivs in + scoped_ivs := []; + let f e = ignore(analyze_aliases false e) in + Type.iter f e; + List.iter (fun iv -> iv.iv_closed <- true) !scoped_ivs; + scoped_ivs := old; + None + in + let analyze_call_args call_args = + let rec loop (vs, es) el = match el with + | e :: el -> + begin match e.eexpr with + | TConst _ -> loop (vs, e::es) el + | _ -> + let v = alloc_var VGenerated "arg" e.etype e.epos in + let decle = mk (TVar(v, Some e)) ctx.t.tvoid e.epos in + ignore(analyze_aliases true decle); + let mde = (Meta.InlineConstructorArgument (v.v_id, 0)), [], e.epos in + let e = mk (TMeta(mde, e)) e.etype e.epos in + loop (v::vs, e::es) el + end + | [] -> vs, (List.rev es) + in + loop ([],[]) call_args + in + let handle_inline_object_case (io_id:int) (force_inline:bool) (e:texpr) = + match e.eexpr, e.etype with + | TNew({ cl_constructor = Some ({cf_expr = Some ({eexpr = TFunction tf})} as cf)} as c,tl,pl),_ + when captured && not (List.memq cf seen_ctors) -> + begin + let argvs, pl = analyze_call_args pl in + let _, cname = c.cl_path in + let v = alloc_var VGenerated ("inl"^cname) e.etype e.epos in + match Inline.type_inline_ctor ctx c cf tf (mk (TLocal v) (TInst (c,tl)) e.epos) pl e.epos with + | Some inlined_expr -> + let inlined_expr = mark_ctors inlined_expr in + let has_untyped = (Meta.has Meta.HasUntyped cf.cf_meta) in + let forced = is_extern_ctor c cf || force_inline in + let io = mk_io (IOKCtor{ioc_class=c; ioc_tparams=tl; ioc_field=cf; ioc_forced=forced}) io_id inlined_expr ~has_untyped:has_untyped in + io.io_dependent_vars <- argvs; + let rec loop (c:tclass) (tl:t list) = + let apply = apply_params c.cl_params tl in + List.iter (fun cf -> + match cf.cf_kind,cf.cf_expr with + | Var _, _ -> + let fieldt = apply cf.cf_type in + ignore(alloc_io_field io cf.cf_name fieldt v.v_pos); + | _ -> () + ) c.cl_ordered_fields; + match c.cl_super with + | Some (c,tl) -> loop c (List.map apply tl) + | None -> () + in loop c tl; + let iv = add v IVKLocal in + set_iv_alias iv io; + ignore(analyze_aliases_in_ctor cf true io.io_expr); + Some iv + | _ -> + List.iter (fun v -> cancel_v v v.v_pos) argvs; + if is_extern_ctor c cf then display_error ctx "Extern constructor could not be inlined" e.epos; + None + end + | TNew({ cl_constructor = Some ({cf_kind = Method MethInline; cf_expr = Some _} as cf)} as c,_,pl),_ when is_extern_ctor c cf -> + error "Extern constructor could not be inlined" e.epos; + | TObjectDecl fl, _ when captured && fl <> [] && List.for_all (fun((s,_,_),_) -> Lexer.is_valid_identifier s) fl -> + let v = alloc_var VGenerated "inlobj" e.etype e.epos in + let ev = mk (TLocal v) v.v_type e.epos in + let el = List.map (fun ((s,_,_),e) -> + let ef = mk (TField(ev,FDynamic s)) e.etype e.epos in + let e = mk (TBinop(OpAssign,ef,e)) e.etype e.epos in + e + ) fl in + let io_expr = make_expr_for_list el ctx.t.tvoid e.epos in + let io = mk_io (IOKStructure) io_id io_expr in + List.iter (fun ((s,_,_),e) -> ignore(alloc_io_field io s e.etype v.v_pos)) fl; + let iv = add v IVKLocal in + set_iv_alias iv io; + List.iter (fun e -> ignore(analyze_aliases true e)) el; + Some iv + | TArrayDecl el, TInst(_, [elemtype]) when captured -> + let len = List.length el in + let v = alloc_var VGenerated "inlarr" e.etype e.epos in + let ev = mk (TLocal v) v.v_type e.epos in + let el = List.mapi (fun i e -> + let ef = mk (TArray(ev,(mk (TConst(TInt (Int32.of_int i))) e.etype e.epos))) elemtype e.epos in + mk (TBinop(OpAssign,ef,e)) elemtype e.epos + ) el in + let io_expr = make_expr_for_list el ctx.t.tvoid e.epos in + let io = mk_io (IOKArray(len)) io_id io_expr in + ignore(alloc_const_io_field io "length" (mk (TConst(TInt (Int32.of_int len))) ctx.t.tint e.epos)); + for i = 0 to len-1 do ignore(alloc_io_field io (int_field_name i) elemtype v.v_pos) done; + let iv = add v IVKLocal in + set_iv_alias iv io; + List.iter (fun e -> ignore(analyze_aliases true e)) el; + Some iv + | _ -> + handle_default_case e + in + match e.eexpr with + | TMeta((Meta.Inline,_,_),{eexpr = TMeta((Meta.InlineObject, [(EConst(Int (id_str)), _)], _), e)}) -> + let io_id = int_of_string id_str in + handle_inline_object_case io_id true e + | TMeta((Meta.InlineObject, [(EConst(Int (id_str)), _)], _), e) -> + let io_id = int_of_string id_str in + handle_inline_object_case io_id false e + | TVar(v,None) -> ignore(add v IVKLocal); None + | TVar(v,Some rve) -> begin match analyze_aliases true rve with | Some({iv_state = IVSAliasing(io)}) -> let iv = add v IVKLocal in @@ -316,7 +450,7 @@ let inline_constructors ctx e = | _ -> () end; None - | TBinop(OpAssign, lve, rve),_ -> + | TBinop(OpAssign, lve, rve) -> begin match analyze_aliases_in_lvalue lve with | Some({iv_state = IVSUnassigned} as iv) -> begin match analyze_aliases true rve with @@ -329,41 +463,74 @@ let inline_constructors ctx e = | Some(iv) -> cancel_iv iv e.epos; ignore(analyze_aliases false rve); None | _ -> ignore(analyze_aliases false rve); None end - | TField(te, fa),_ -> - handle_field_case te (field_name fa) (fun _ -> true) - | TArray(te,{eexpr = TConst (TInt i)}),_ -> + | TField(ethis, fa) -> + handle_field_case_no_methods e ethis (field_name fa) (fun _ -> true) + | TArray(ethis,{eexpr = TConst (TInt i)}) -> let i = Int32.to_int i in let validate_io io = match io.io_kind with IOKArray(l) when i >= 0 && i < l -> true | _ -> false in - handle_field_case te (int_field_name i) validate_io - | TLocal(v),_ when v.v_id < 0 -> + handle_field_case_no_methods e ethis (int_field_name i) validate_io + | TLocal(v) when v.v_id < 0 -> let iv = get_iv v.v_id in if iv.iv_closed || not captured then cancel_iv iv e.epos; Some iv - | TBlock(el),_ -> + | TBlock(el) -> let rec loop = function | [e] -> analyze_aliases captured e | e::el -> ignore(analyze_aliases true e); loop (el) | [] -> None in loop el - | TMeta((Meta.InlineConstructorArgument (vid,_),_,_),_),_ -> + | TMeta((Meta.InlineConstructorArgument (vid,_),_,_),_) -> + (* The contents have already been analyzed, so we must skip the wrapped expression *) (try let iv = get_iv vid in if iv.iv_closed || not captured then cancel_iv iv e.epos; Some(get_iv vid) with Not_found -> None) - | TParenthesis e,_ | TMeta(_,e),_ | TCast(e,None),_ -> + | TParenthesis e | TMeta(_,e) | TCast(e,None) -> analyze_aliases captured e - | _,_ -> - let old = !scoped_ivs in - scoped_ivs := []; - let f e = ignore(analyze_aliases false e) in - Type.iter f e; - List.iter (fun iv -> iv.iv_closed <- true) !scoped_ivs; - scoped_ivs := old; - None + | TCall(({eexpr=TField(ethis,fa)} as efield),call_args) -> + let fname = field_name fa in + let fiv = handle_field_case efield ethis fname (fun _ -> true) in + begin match fiv with + | IOFInlineMethod(io,io_var,c,tl,cf,tf) -> + let argvs, pl = analyze_call_args call_args in + io.io_dependent_vars <- io.io_dependent_vars @ argvs; + io.io_has_untyped <- io.io_has_untyped or (Meta.has Meta.HasUntyped cf.cf_meta); + begin match Inline.type_inline ctx cf tf (mk (TLocal io_var.iv_var) (TInst (c,tl)) e.epos) pl e.etype None e.epos true with + | Some e -> + let e = mark_ctors e in + io.io_inline_methods <- io.io_inline_methods @ [e]; + begin match analyze_aliases captured e with + | Some(iv) -> + (* + The parent inline object might have been cancelled while analyzing the inlined method body + If the parent inline object is cancelled the inlining of this method will no longer happen, + so the return value must be cancelled. + *) + if io.io_cancelled then begin + cancel_iv iv e.epos; + None + end else begin + io.io_dependent_vars <- iv.iv_var :: io.io_dependent_vars; + Some(iv) + end + | None -> None + end + | None -> + cancel_io io e.epos; + None + end + | IOFInlineVar(iv) -> + cancel_iv iv e.epos; + List.iter (fun ca -> ignore(analyze_aliases false ca)) call_args; + None + | IOFNone -> + List.iter (fun ca -> ignore(analyze_aliases false ca)) call_args; + None + end + | _ -> + handle_default_case e in - ignore(analyze_aliases [] false false e); - current_io_id := 0; let rec get_iv_var_decls (iv:inline_var) : texpr list = match iv with | {iv_state = IVSAliasing io} -> get_io_var_decls io @@ -380,7 +547,6 @@ let inline_constructors ctx e = in let included_untyped = ref false in let rec final_map ?(unwrap_block = false) (e:texpr) : ((texpr list) * (inline_object option)) = - increment_io_id e; let default_case e = let f e = let (el,_) = final_map e in @@ -388,22 +554,49 @@ let inline_constructors ctx e = in ([Type.map_expr f e], None) in + (* + field_case handles the final map of TField expressions. + The last bool in the returned tuple indicates that the field was handled as an inlined method. + *) + let field_case ethis fa efield : ((texpr list) * (inline_object option) * bool) = + let (tel, thiso) = final_map ethis in + begin match thiso with + | Some io -> + let fname = field_name fa in + begin try match get_io_field io fname with + | {iv_state = IVSAliasing io} -> + tel, Some io, false + | iv -> + let newexpr = match iv.iv_kind with + | IVKField(_,_,Some constexpr) -> {constexpr with epos = e.epos} + | _ -> mk (TLocal iv.iv_var) efield.etype efield.epos + in + (newexpr::tel), None, false + with Not_found -> + (* Since the field is not an inline variable then it must be an inlined method call *) + match io.io_inline_methods with + | e::el -> + (* method fields will appear in the same order as they did during analysis, so we consume the first and remove it from the list *) + io.io_inline_methods <- el; + let el, io = final_map e in + el @ tel, io, true + | _ -> die "" __LOC__ + end + | None -> + let te = make_expr_for_rev_list tel ethis.etype ethis.epos in + [mk (TField(te, fa)) efield.etype efield.epos], None, false + end + in match e.eexpr with - | TObjectDecl _ | TArrayDecl _ | TNew _ | (TMeta((Meta.Inline,_,_),{eexpr = TNew _})) -> + | TMeta((Meta.InlineObject, [(EConst(Int (id_str)), _)], _), e) -> + let io_id = int_of_string id_str in begin try - let io = get_io !current_io_id in - if io.io_cancelled then begin - let result = default_case e in - current_io_id := io.io_id_end; - result - end else begin - if io.io_has_untyped then included_untyped := true; - current_io_id := io.io_id_start; - let el,_ = final_map ~unwrap_block:true io.io_expr in - let el = el @ get_io_var_decls io in - assert (!current_io_id = io.io_id_end); - (el,Some io) - end + let io = get_io io_id in + if io.io_cancelled then raise Not_found; + if io.io_has_untyped then included_untyped := true; + let el,_ = final_map ~unwrap_block:true io.io_expr in + let el = el @ get_io_var_decls io in + (el,Some io) with Not_found -> default_case e end @@ -427,27 +620,29 @@ let inline_constructors ctx e = (e::el), None end end - | TField(te, fa) -> - let (tel, thiso) = final_map te in - begin match thiso with - | Some io -> - let fname = field_name fa in - begin match get_io_field io fname with - | {iv_state = IVSAliasing io} -> - tel, Some io - | iv -> - let newexpr = match iv.iv_kind with - | IVKField(_,_,Some constexpr) -> {constexpr with epos = e.epos} - | _ -> mk (TLocal iv.iv_var) e.etype e.epos - in - (newexpr::tel), None - end - | None -> - let te = make_expr_for_rev_list tel te.etype te.epos in - [mk (TField(te, fa)) e.etype e.epos], None + | TCall(({eexpr=TField(ethis,fa)} as efield),call_args) -> + begin match field_case ethis fa efield with + | el, io, true -> (* the field was an inlined method *) + el, io + | el, _, false -> (* the field was a normal field access *) + (* + This is equivalent to `default_case e`, but field_case already run final_map + on the TField expression so we must reuse those results. + *) + let f e = + let (el,_) = final_map e in + make_expr_for_rev_list el e.etype e.epos + in + let e1 = make_expr_for_rev_list el efield.etype efield.epos in + let e = {e with eexpr = TCall(e1, List.map f call_args)} in + [e], None end - | TArray(te, ({eexpr = TConst (TInt i)} as indexexpr)) -> - let (tel, thiso) = final_map te in + | TField(ethis, fa) -> + let el, io, is_method = field_case ethis fa e in + assert(not is_method); + el, io + | TArray(ethis, ({eexpr = TConst (TInt i)} as indexexpr)) -> + let (tel, thiso) = final_map ethis in begin match thiso with | Some io -> let i = Int32.to_int i in @@ -460,7 +655,7 @@ let inline_constructors ctx e = (local::tel), None end | None -> - let te = make_expr_for_rev_list tel te.etype te.epos in + let te = make_expr_for_rev_list tel ethis.etype ethis.epos in [mk (TArray(te, indexexpr)) e.etype e.epos], None end | TLocal v when v.v_id < 0 -> @@ -483,12 +678,8 @@ let inline_constructors ctx e = let el, io = loop [] el in let el = if unwrap_block || Option.is_some io then el else [mk (TBlock (List.rev el)) e.etype e.epos] in el, io - | TMeta((Meta.InlineConstructorArgument (_,io_id_start),_,_),e) -> - let old_io_id = !current_io_id in - current_io_id := io_id_start; - let result = final_map e in - current_io_id := old_io_id; - result + | TMeta((Meta.InlineConstructorArgument (_,_),_,_),e) -> + final_map e | TParenthesis e' | TCast(e',None) | TMeta(_,e') -> let el, io = final_map e' in begin match io with @@ -500,9 +691,12 @@ let inline_constructors ctx e = end | _ -> default_case e in + if not (check_for_ctors original_e) then original_e else + let e = mark_ctors original_e in + ignore(analyze_aliases [] false false e); if IntMap.for_all (fun _ io -> io.io_cancelled) !inline_objs then begin IntMap.iter (fun _ iv -> let v = iv.iv_var in if v.v_id < 0 then v.v_id <- -v.v_id ) !vars; - e + original_e end else begin let el,_ = final_map e in let cf = ctx.curfield in diff --git a/src/optimization/optimizer.ml b/src/optimization/optimizer.ml index cd73d52c..22ad09e3 100644 --- a/src/optimization/optimizer.ml +++ b/src/optimization/optimizer.ml @@ -304,7 +304,7 @@ let rec reduce_loop ctx e = (match inl with | None -> reduce_expr ctx e | Some e -> reduce_loop ctx e) - | {eexpr = TField(ef,(FStatic(cl,cf) | FInstance(cl,_,cf)))} when cf.cf_kind = Method MethInline && not (rec_stack_memq cf inline_stack) -> + | {eexpr = TField(ef,(FStatic(cl,cf) | FInstance(cl,_,cf)))} when needs_inline ctx (has_class_flag cl CExtern) cf && not (rec_stack_memq cf inline_stack) -> begin match cf.cf_expr with | Some {eexpr = TFunction tf} -> let config = inline_config (Some cl) cf el e.etype in @@ -374,482 +374,4 @@ let rec make_constant_expression ctx ?(concat_strings=false) e = | None -> None | Some e -> make_constant_expression ctx e) with Not_found -> None) *) - | _ -> None - -(* ---------------------------------------------------------------------- *) -(* INLINE CONSTRUCTORS *) -(* This version is disabled by default, use -D old-constructor-inline to use this *) - -(* - First pass : - We will look at local variables in the form var v = new .... - we only capture the ones which have constructors marked as inlined - then we make sure that these locals are no more referenced except for fields accesses - - Second pass : - We replace the variables by their fields lists, and the corresponding fields accesses as well -*) - -type inline_info_kind = - | IKCtor of tclass_field * bool - | IKStructure - | IKArray of int - -type inline_info = { - ii_var : tvar; - ii_expr : texpr; - ii_kind : inline_info_kind; - mutable ii_fields : (string,tvar) PMap.t; -} - -let inline_constructors ctx e = - let vars = ref IntMap.empty in - let cancel v p = - try - let ii = IntMap.find v.v_id !vars in - vars := IntMap.remove v.v_id !vars; - v.v_id <- -v.v_id; - begin match ii.ii_kind with - | IKCtor(cf,true) -> - display_error ctx "Extern constructor could not be inlined" p; - error "Variable is used here" p; - | _ -> - () - end; - with Not_found -> - () - in - let add v e kind = - let ii = { - ii_var = v; - ii_fields = PMap.empty; - ii_expr = e; - ii_kind = kind - } in - v.v_id <- -v.v_id; - vars := IntMap.add v.v_id ii !vars; - in - let get_field_var v s = - let ii = IntMap.find v.v_id !vars in - PMap.find s ii.ii_fields - in - let add_field_var v s t = - let ii = IntMap.find v.v_id !vars in - let v' = alloc_var VInlinedConstructorVariable (Printf.sprintf "%s_%s" v.v_name s) t v.v_pos in - ii.ii_fields <- PMap.add s v' ii.ii_fields; - v' - in - let int_field_name i = - if i < 0 then "n" ^ (string_of_int (-i)) - else (string_of_int i) - in - let is_extern_ctor c cf = c.cl_extern || has_class_field_flag cf CfExtern in - let rec find_locals e = match e.eexpr with - | TVar(v,Some e1) -> - find_locals e1; - let rec loop el_init e1 = match e1.eexpr with - | TBlock el -> - begin match List.rev el with - | e1 :: el -> - loop (el @ el_init) e1 - | [] -> - () - end - | TNew({ cl_constructor = Some ({cf_kind = Method MethInline; cf_expr = Some ({eexpr = TFunction tf})} as cf)} as c,tl,pl) when type_iseq v.v_type e1.etype -> - begin match type_inline_ctor ctx c cf tf (mk (TLocal v) (TInst (c,tl)) e1.epos) pl e1.epos with - | Some e -> - let e' = match el_init with - | [] -> e - | _ -> mk (TBlock (List.rev (e :: el_init))) e.etype e.epos - in - add v e' (IKCtor(cf,is_extern_ctor c cf)); - find_locals e - | None -> - () - end - | TObjectDecl fl when fl <> [] -> - begin try - let ev = mk (TLocal v) v.v_type e.epos in - let el = List.fold_left (fun acc ((s,_,_),e) -> - if not (Lexer.is_valid_identifier s) then raise Exit; - let ef = mk (TField(ev,FDynamic s)) e.etype e.epos in - let e = mk (TBinop(OpAssign,ef,e)) e.etype e.epos in - e :: acc - ) el_init fl in - let e = mk (TBlock (List.rev el)) ctx.t.tvoid e.epos in - add v e IKStructure - with Exit -> - () - end - | TArrayDecl el -> - let ev = mk (TLocal v) v.v_type e.epos in - let el,_ = List.fold_left (fun (acc,i) e -> - let ef = mk (TField(ev,FDynamic (string_of_int i))) e.etype e.epos in - let e = mk (TBinop(OpAssign,ef,e)) e.etype e.epos in - e :: acc,i + 1 - ) (el_init,0) el in - let e = mk (TBlock (List.rev el)) ctx.t.tvoid e.epos in - add v e (IKArray (List.length el)) - | TCast(e1,None) | TParenthesis e1 -> - loop el_init e1 - | _ -> - () - in - loop [] e1 - | TBinop(OpAssign,({eexpr = TField({eexpr = TLocal v},fa)} as e1),e2) when v.v_id < 0 -> - let s = field_name fa in - (try ignore(get_field_var v s) with Not_found -> ignore(add_field_var v s e1.etype)); - find_locals e2 - | TField({eexpr = TLocal v},fa) when v.v_id < 0 -> - begin match extract_field fa with - | Some ({cf_kind = Var _} as cf) -> - (* Arrays are not supposed to have public var fields, besides "length" (which we handle when inlining), - however, its inlined methods may generate access to private implementation fields (such as internal - native array), in this case we have to cancel inlining. - *) - if cf.cf_name <> "length" then - begin match (IntMap.find v.v_id !vars).ii_kind with - | IKArray _ -> cancel v e.epos - | _ -> (try ignore(get_field_var v cf.cf_name) with Not_found -> ignore(add_field_var v cf.cf_name e.etype)); - end - | _ -> cancel v e.epos - end - | TArray({eexpr = TLocal v},{eexpr = TConst (TInt i)}) when v.v_id < 0 -> - let i = Int32.to_int i in - begin try - let ii = IntMap.find v.v_id !vars in - let l = match ii.ii_kind with - | IKArray l -> l - | _ -> raise Not_found - in - if i < 0 || i >= l then raise Not_found; - with Not_found -> - cancel v e.epos - end - | TLocal v when v.v_id < 0 -> - cancel v e.epos; - | _ -> - Type.iter find_locals e - in - find_locals e; - (* Pass 2 *) - let inline v p = - try - let ii = IntMap.find v.v_id !vars in - let el = PMap.fold (fun v acc -> (mk (TVar(v,None)) ctx.t.tvoid p) :: acc) ii.ii_fields [] in - let e = {ii.ii_expr with eexpr = TBlock (el @ [ii.ii_expr])} in - Some e - with Not_found -> - None - in - let assign_or_declare v name e2 t p = - try - let v = get_field_var v name in - let e1 = mk (TLocal v) t p in - mk (TBinop(OpAssign,e1,e2)) e1.etype p - with Not_found -> - let v = add_field_var v name t in - mk (TVar(v,Some e2)) ctx.t.tvoid e.epos - in - let use_local_or_null v name t p = - try - let v' = get_field_var v name in - mk (TLocal v') t p - with Not_found -> try - if name <> "length" then raise Not_found; - let ii = IntMap.find v.v_id !vars in - begin match ii.ii_kind with - | IKArray l -> mk (TConst (TInt (Int32.of_int l))) ctx.t.tint p - | _ -> raise Not_found - end - with Not_found -> - mk (TConst TNull) t p - in - let flatten e = - let el = ref [] in - let rec loop e = match e.eexpr with - | TBlock el -> - List.iter loop el - | _ -> - el := e :: !el - in - loop e; - let e = mk (TBlock (List.rev !el)) e.etype e.epos in - mk (TMeta((Meta.MergeBlock,[],e.epos),e)) e.etype e.epos - in - let rec loop e = match e.eexpr with - | TVar(v,_) when v.v_id < 0 -> - begin match inline v e.epos with - | Some e -> - let e = flatten e in - loop e - | None -> - cancel v e.epos; - e - end - | TBinop(OpAssign,({eexpr = TField({eexpr = TLocal v},fa)} as e1),e2) when v.v_id < 0 -> - let e2 = loop e2 in - assign_or_declare v (field_name fa) e2 e1.etype e.epos - | TField({eexpr = TLocal v},fa) when v.v_id < 0 -> - use_local_or_null v (field_name fa) e.etype e.epos - | TBinop(OpAssign,({eexpr = TArray({eexpr = TLocal v},{eexpr = TConst (TInt i)})} as e1),e2) when v.v_id < 0 -> - let e2 = loop e2 in - let name = int_field_name (Int32.to_int i) in - assign_or_declare v name e2 e1.etype e.epos - | TArray({eexpr = TLocal v},{eexpr = TConst (TInt i)}) when v.v_id < 0 -> - use_local_or_null v (int_field_name (Int32.to_int i)) e.etype e.epos - | TBlock el -> - let rec block acc el = match el with - | e1 :: el -> - begin match loop e1 with - | {eexpr = TMeta((Meta.MergeBlock,_,_),{eexpr = TBlock el2})} -> - let acc = block acc el2 in - block acc el - | e -> block (e :: acc) el - end - | [] -> - acc - in - let el = block [] el in - mk (TBlock (List.rev el)) e.etype e.epos - | TNew({ cl_constructor = Some ({cf_kind = Method MethInline; cf_expr = Some ({eexpr = TFunction _})} as cf)} as c,_,_) when is_extern_ctor c cf -> - display_error ctx "Extern constructor could not be inlined" e.epos; - Type.map_expr loop e - | _ -> - Type.map_expr loop e - in - loop e - -(* ---------------------------------------------------------------------- *) -(* COMPLETION *) - -exception Return of Ast.expr - -type compl_locals = { - mutable r : (string, (complex_type option * (int * Ast.expr * compl_locals) option)) PMap.t; -} - -let optimize_completion_expr e args = - let iid = ref 0 in - let typing_side_effect = ref false in - let locals : compl_locals = { r = PMap.empty } in - let save() = let old = locals.r in (fun() -> locals.r <- old) in - let get_local n = PMap.find n locals.r in - let maybe_typed e = - match fst e with - | EConst (Ident "null") -> false - | _ -> true - in - let decl n t e = - typing_side_effect := true; - locals.r <- PMap.add n (t,(match e with Some e when maybe_typed e -> incr iid; Some (!iid,e,{ r = locals.r }) | _ -> None)) locals.r - in - let rec hunt_idents e = match fst e with - | EConst (Ident i) -> decl i None None - | _ -> Ast.iter_expr hunt_idents e - in - let e0 = e in - let rec loop e = - let p = snd e in - match fst e with - | EConst (Ident n) -> - (try - (match get_local n with - | Some _ , _ -> () - | _ -> typing_side_effect := true) - with Not_found -> - ()); - e - | EBinop (OpAssign,(EConst (Ident n),_),esub) -> - (try - (match get_local n with - | None, None when maybe_typed esub -> decl n None (Some esub) - | _ -> ()) - with Not_found -> - ()); - map e - | EVars vl -> - let vl = List.map (fun ((v,pv),final,t,e) -> - let e = (match e with None -> None | Some e -> Some (loop e)) in - decl v (Option.map fst t) e; - ((v,pv),final,t,e) - ) vl in - (EVars vl,p) - | EBlock el -> - let old = save() in - let told = ref (!typing_side_effect) in - let el = List.fold_left (fun acc e -> - typing_side_effect := false; - let e = loop e in - if !typing_side_effect || DisplayPosition.display_position#enclosed_in (pos e) then begin told := true; e :: acc end else acc - ) [] el in - old(); - typing_side_effect := !told; - (EBlock (List.rev el),p) - | EFunction (kind,f) -> - (match kind with - | FKNamed ((name,_),_) -> - decl name None (Some e) - | _ -> ()); - let old = save() in - List.iter (fun ((n,_),_,_,t,e) -> decl n (Option.map fst t) e) f.f_args; - let e = map e in - old(); - e - | EFor (header,body) -> - let idents = ref [] - and has_in = ref false in - let rec collect_idents e = - match e with - | EConst (Ident name), p -> - idents := (name,p) :: !idents; - e - | EBinop (OpIn, e, it), p -> - has_in := true; - (EBinop (OpIn, collect_idents e, loop it), p) - | _ -> - Ast.map_expr collect_idents e - in - let header = collect_idents header in - (match !idents,!has_in with - | [],_ | _,false -> map e - | idents,true -> - let old = save() in - List.iter - (fun (name, pos) -> - let etmp = (EConst (Ident "`tmp"),pos) in - decl name None (Some (EBlock [ - (EVars [("`tmp",null_pos),false,None,None],p); - (EFor(header,(EBinop (OpAssign,etmp,(EConst (Ident name),p)),p)), p); - etmp - ],p)); - ) - idents; - let body = loop body in - old(); - (EFor(header,body),p) - ) - | EReturn _ -> - typing_side_effect := true; - map e - | ESwitch (e1,cases,def) when DisplayPosition.display_position#enclosed_in p -> - let e1 = loop e1 in - hunt_idents e1; - (* Prune all cases that aren't our display case *) - let cases = List.filter (fun (_,_,_,p) -> DisplayPosition.display_position#enclosed_in p) cases in - (* Don't throw away the switch subject when we optimize in a case expression because we might need it *) - let cases = List.map (fun (el,eg,eo,p) -> - List.iter hunt_idents el; - el,eg,(try Option.map loop eo with Return e -> Some e),p - ) cases in - let def = match def with - | None -> None - | Some (None,p) -> Some (None,p) - | Some (Some e,p) -> Some (Some (loop e),p) - in - (ESwitch (e1,cases,def),p) - | ESwitch (e,cases,def) -> - let e = loop e in - let cases = List.map (fun (el,eg,eo,p) -> match eo with - | None -> - el,eg,eo,p - | Some e -> - let el = List.map loop el in - let old = save() in - List.iter hunt_idents el; - let e = loop e in - old(); - el, eg, Some e, p - ) cases in - let def = match def with - | None -> None - | Some (None,p) -> Some (None,p) - | Some (Some e,p) -> Some (Some (loop e),p) - in - (ESwitch (e,cases,def),p) - | ETry (et,cl) -> - let et = loop et in - let cl = List.map (fun ((n,pn),th,e,p) -> - let old = save() in - decl n (Option.map fst th) None; - let e = loop e in - old(); - (n,pn), th, e, p - ) cl in - (ETry (et,cl),p) - | ECall(e1,el) when DisplayPosition.display_position#enclosed_in p -> - let e1 = loop e1 in - let el = List.map (fun e -> - if DisplayPosition.display_position#enclosed_in (pos e) then - (try loop e with Return e -> e) - else - (EConst (Ident "null"),(pos e)) - ) el in - (ECall(e1,el),p) - | ECheckType(e1,th) -> - typing_side_effect := true; - let e1 = loop e1 in - (ECheckType(e1,th),p) - | EMeta(m,e1) -> - begin try - let e1 = loop e1 in - (EMeta(m,e1),(pos e)) - with Return e1 -> - let e1 = (EMeta(m,e1),(pos e)) in - raise (Return e1) - end - | EDisplay(_,DKStructure) -> - raise (Return e0) - | EDisplay (s,call) -> - typing_side_effect := true; - let tmp_locals = ref [] in - let tmp_hlocals = ref PMap.empty in - let rec subst_locals locals e = - match fst e with - | EConst (Ident n) -> - let p = snd e in - (try - (match PMap.find n locals.r with - | Some t , _ -> (ECheckType ((EConst (Ident "null"),p),(t,p)),p) - | _, Some (id,e,lc) -> - let name = (try - PMap.find id (!tmp_hlocals) - with Not_found -> - let e = subst_locals lc e in - let name = "`tmp_" ^ string_of_int id in - tmp_locals := ((name,null_pos),false,None,Some e) :: !tmp_locals; - tmp_hlocals := PMap.add id name !tmp_hlocals; - name - ) in - (EConst (Ident name),p) - | None, None -> - (* we can't replace the var *) - raise Exit) - with Not_found -> - (* not found locals are most likely to be member/static vars *) - e) - | EFunction (_,f) -> - Ast.map_expr (subst_locals { r = PMap.foldi (fun n i acc -> if List.exists (fun ((a,_),_,_,_,_) -> a = n) f.f_args then acc else PMap.add n i acc) locals.r PMap.empty }) e - | EObjectDecl [] -> - (* this probably comes from { | completion so we need some context} *) - raise Exit - | _ -> - Ast.map_expr (subst_locals locals) e - in - (try - let e = subst_locals locals s in - let e = (EBlock [(EVars (List.rev !tmp_locals),p);(EDisplay (e,call),p)],p) in - raise (Return e) - with Exit -> - map e) - | EDisplayNew _ -> - raise (Return e) - | _ -> - map e - and map e = - Ast.map_expr loop e - in - List.iter (fun ((n,_),_,_,t,e) -> decl n (Option.map fst t) e) args; - (try loop e with Return e -> e) - -(* ---------------------------------------------------------------------- *) + | _ -> None \ No newline at end of file diff --git a/src/optimization/optimizerTexpr.ml b/src/optimization/optimizerTexpr.ml index 02753028..9ff69ba0 100644 --- a/src/optimization/optimizerTexpr.ml +++ b/src/optimization/optimizerTexpr.ml @@ -37,7 +37,7 @@ let is_read_only_field_access e fa = match fa with begin match cf.cf_kind with | Method MethDynamic -> false | Method _ -> true - | Var {v_write = AccNever} when not c.cl_interface -> true + | Var {v_write = AccNever} when not (has_class_flag c CInterface) -> true | _ -> false end | FAnon cf | FClosure(None,cf) -> @@ -52,7 +52,7 @@ let create_affection_checker () = let rec might_be_affected e = let rec loop e = match e.eexpr with | TConst _ | TFunction _ | TTypeExpr _ -> () - | TLocal {v_capture = true} -> raise Exit + | TLocal v when has_var_flag v VCaptured -> raise Exit | TLocal v when Hashtbl.mem modified_locals v.v_id -> raise Exit | TField(e1,fa) when not (is_read_only_field_access e1 fa) -> raise Exit | TCall _ | TNew _ -> raise Exit diff --git a/src/syntax/grammar.mly b/src/syntax/grammar.mly index 5df2fe15..d0315c04 100644 --- a/src/syntax/grammar.mly +++ b/src/syntax/grammar.mly @@ -157,13 +157,12 @@ and parse_type_decls mode pmax pack acc s = ignore(resume false false s); parse_type_decls mode (last_pos s).pmax pack acc s -and parse_abstract doc meta flags = parser - | [< '(Kwd Abstract,p1); name = type_name; tl = parse_constraint_params; st = parse_abstract_subtype; sl = plist parse_abstract_relations; s >] -> +and parse_abstract doc meta flags p1 = parser + | [< name = type_name; tl = parse_constraint_params; st = parse_abstract_subtype; sl = plist parse_abstract_relations; s >] -> let fl,p2 = match s with parser | [< '(BrOpen,_); fl, p2 = parse_class_fields false p1 >] -> fl,p2 | [< >] -> syntax_error (Expected ["{";"to";"from"]) s ([],last_pos s) in - let flags = List.map decl_flag_to_abstract_flag flags in let flags = (match st with None -> flags | Some t -> AbOver t :: flags) in ({ d_name = name; @@ -174,15 +173,100 @@ and parse_abstract doc meta flags = parser d_data = fl; },punion p1 p2) +and parse_class_content doc meta flags n p1 s = + let name = type_name s in + let tl = parse_constraint_params s in + let rec loop had_display p0 acc = + let check_display p1 = + if not had_display && !in_display_file && display_position#enclosed_in p1 then + syntax_completion (if List.mem HInterface n then SCInterfaceRelation else SCClassRelation) None (display_position#with_pos p1) + in + match s with parser + | [< '(Kwd Extends,p1); t,b = parse_type_path_or_resume p1 >] -> + check_display {p1 with pmin = p0.pmax; pmax = p1.pmin}; + let p0 = pos t in + (* If we don't have type parameters, we have to offset by one so to not complete `extends` + and `implements` after the identifier. *) + let p0 = {p0 with pmax = p0.pmax + (if (fst t).tparams = [] then 1 else 0)} in + loop (had_display || b) p0 ((HExtends t) :: acc) + | [< '(Kwd Implements,p1); t,b = parse_type_path_or_resume p1 >] -> + check_display {p1 with pmin = p0.pmax; pmax = p1.pmin}; + let p0 = pos t in + let p0 = {p0 with pmax = p0.pmax + (if (fst t).tparams = [] then 1 else 0)} in + loop (had_display || b) p0 ((HImplements t) :: acc) + | [< '(BrOpen,p1) >] -> + check_display {p1 with pmin = p0.pmax; pmax = p1.pmin}; + List.rev acc + | [< >] -> + begin match Stream.peek s with + | Some((Const(Ident name),p)) when display_position#enclosed_in p -> + syntax_completion (if List.mem HInterface n then SCInterfaceRelation else SCClassRelation) (Some name) p + | _ -> + check_display {p1 with pmin = p0.pmax; pmax = (next_pos s).pmax}; + syntax_error (Expected ["extends";"implements";"{"]) s (List.rev acc) + end + in + let hl = loop false (last_pos s) [] in + let fl, p2 = parse_class_fields false p1 s in + (EClass { + d_name = name; + d_doc = doc_from_string_opt doc; + d_meta = meta; + d_params = tl; + d_flags = ExtList.List.filter_map decl_flag_to_class_flag flags @ n @ hl; + d_data = fl; + }, punion p1 p2) + and parse_type_decl mode s = match s with parser | [< '(Kwd Import,p1) >] -> parse_import s p1 | [< '(Kwd Using,p1) >] -> parse_using s p1 | [< doc = get_doc; meta = parse_meta; c = parse_common_flags; s >] -> match s with parser + | [< '(Kwd Function,p1); name = dollar_ident; pl = parse_constraint_params; '(POpen,_); args = psep Comma parse_fun_param; '(PClose,_); t = popt parse_type_hint; s >] -> + let e, p2 = (match s with parser + | [< e = expr; s >] -> + ignore(semicolon s); + Some e, pos e + | [< p = semicolon >] -> None, p + | [< >] -> serror() + ) in + let f = { + f_params = pl; + f_args = args; + f_type = t; + f_expr = e; + } in + (EStatic { + d_name = name; + d_doc = doc_from_string_opt doc; + d_meta = meta; + d_params = pl; + d_flags = ExtList.List.filter_map decl_flag_to_module_field_flag c; + d_data = FFun f; + }, punion p1 p2) + | [< '(Kwd Var,p1); name = dollar_ident; s >] -> + let p2,t = + match s with parser + | [< '(POpen,_); i1 = property_ident; '(Comma,_); i2 = property_ident; '(PClose,_) >] -> + let t = popt parse_type_hint s in + let e,p2 = parse_var_field_assignment s in + p2,FProp (i1,i2,t,e) + | [< t = popt parse_type_hint; s >] -> + let e,p2 = parse_var_field_assignment s in + p2,FVar (t,e) + in + (EStatic { + d_name = name; + d_doc = doc_from_string_opt doc; + d_meta = meta; + d_params = []; + d_flags = ExtList.List.filter_map decl_flag_to_module_field_flag c; + d_data = t; + }, punion p1 p2) | [< '(Kwd Enum,p1) >] -> begin match s with parser - | [< a,p = parse_abstract doc ((Meta.Enum,[],null_pos) :: meta) c >] -> + | [< '(Kwd Abstract,p1); a,p = parse_abstract doc meta (AbEnum :: (convert_abstract_flags c)) p1 >] -> (EAbstract a,p) | [< name = type_name; tl = parse_constraint_params; '(BrOpen,_); l = plist parse_enum; '(BrClose,p2) >] -> (EEnum { @@ -190,51 +274,12 @@ and parse_type_decl mode s = d_doc = doc_from_string_opt doc; d_meta = meta; d_params = tl; - d_flags = List.map decl_flag_to_enum_flag c; + d_flags = ExtList.List.filter_map decl_flag_to_enum_flag c; d_data = l }, punion p1 p2) end - | [< n , p1 = parse_class_flags; name = type_name; tl = parse_constraint_params >] -> - let rec loop had_display p0 acc = - let check_display p1 = - if not had_display && !in_display_file && display_position#enclosed_in p1 then - syntax_completion (if List.mem HInterface n then SCInterfaceRelation else SCClassRelation) None (display_position#with_pos p1) - in - match s with parser - | [< '(Kwd Extends,p1); t,b = parse_type_path_or_resume p1 >] -> - check_display {p1 with pmin = p0.pmax; pmax = p1.pmin}; - let p0 = pos t in - (* If we don't have type parameters, we have to offset by one so to not complete `extends` - and `implements` after the identifier. *) - let p0 = {p0 with pmax = p0.pmax + (if (fst t).tparams = [] then 1 else 0)} in - loop (had_display || b) p0 ((HExtends t) :: acc) - | [< '(Kwd Implements,p1); t,b = parse_type_path_or_resume p1 >] -> - check_display {p1 with pmin = p0.pmax; pmax = p1.pmin}; - let p0 = pos t in - let p0 = {p0 with pmax = p0.pmax + (if (fst t).tparams = [] then 1 else 0)} in - loop (had_display || b) p0 ((HImplements t) :: acc) - | [< '(BrOpen,p1) >] -> - check_display {p1 with pmin = p0.pmax; pmax = p1.pmin}; - List.rev acc - | [< >] -> - begin match Stream.peek s with - | Some((Const(Ident name),p)) when display_position#enclosed_in p -> - syntax_completion (if List.mem HInterface n then SCInterfaceRelation else SCClassRelation) (Some name) p - | _ -> - check_display {p1 with pmin = p0.pmax; pmax = (next_pos s).pmax}; - syntax_error (Expected ["extends";"implements";"{"]) s (List.rev acc) - end - in - let hl = loop false (last_pos s) [] in - let fl, p2 = parse_class_fields false p1 s in - (EClass { - d_name = name; - d_doc = doc_from_string_opt doc; - d_meta = meta; - d_params = tl; - d_flags = List.map decl_flag_to_class_flag c @ n @ hl; - d_data = fl; - }, punion p1 p2) + | [< n , p1 = parse_class_flags >] -> + parse_class_content doc meta c n p1 s | [< '(Kwd Typedef,p1); name = type_name; tl = parse_constraint_params; '(Binop OpAssign,p2); t = parse_complex_type_at p2; s >] -> (match s with parser | [< '(Semicolon,_) >] -> () @@ -244,13 +289,38 @@ and parse_type_decl mode s = d_doc = doc_from_string_opt doc; d_meta = meta; d_params = tl; - d_flags = List.map decl_flag_to_enum_flag c; + d_flags = ExtList.List.filter_map decl_flag_to_enum_flag c; d_data = t; }, punion p1 (pos t)) - | [< a,p = parse_abstract doc meta c >] -> - EAbstract a,p + | [< '(Kwd Abstract,p1) >] -> + begin match s with parser + | [< a,p = parse_abstract doc meta (convert_abstract_flags c) p1 >] -> + EAbstract a,p + | [< >] -> + let c2 = parse_common_flags s in + begin match s with parser + | [< flags,_ = parse_class_flags >] -> + parse_class_content doc meta (c @ c2) (HAbstract :: flags) p1 s + | [< >] -> + serror() + end + end | [< >] -> - check_type_decl_flag_completion mode c s + match List.rev c with + | (DFinal,p1) :: crest -> + (match s with parser + | [< name = dollar_ident; t = popt parse_type_hint; e,p2 = parse_var_field_assignment >] -> + (EStatic { + d_name = name; + d_doc = doc_from_string_opt doc; + d_meta = meta; + d_params = []; + d_flags = (ExtList.List.filter_map decl_flag_to_module_field_flag (List.rev crest)) @ [AFinal,p1]; + d_data = FVar(t,e); + }, punion p1 p2) + | [< >] -> check_type_decl_flag_completion mode c s) + | _ -> + check_type_decl_flag_completion mode c s and parse_class doc meta cflags need_name s = @@ -405,7 +475,7 @@ and resume tdecl fdecl s = | Kwd New :: Kwd Function :: _ when fdecl -> junk_tokens (k - 2); true - | Kwd Macro :: _ | Kwd Public :: _ | Kwd Static :: _ | Kwd Var :: _ | Kwd Override :: _ | Kwd Dynamic :: _ | Kwd Inline :: _ when fdecl -> + | Kwd Macro :: _ | Kwd Public :: _ | Kwd Static :: _ | Kwd Var :: _ | Kwd Override :: _ | Kwd Dynamic :: _ | Kwd Inline :: _ | Kwd Overload :: _ when fdecl -> junk_tokens (k - 1); true | BrClose :: _ when tdecl -> @@ -459,6 +529,12 @@ and parse_common_flags = parser | [< '(Kwd Private,p); l = parse_common_flags >] -> (DPrivate,p) :: l | [< '(Kwd Extern,p); l = parse_common_flags >] -> (DExtern,p) :: l | [< '(Kwd Final,p); l = parse_common_flags >] -> (DFinal,p) :: l + | [< '(Kwd Macro,p); l = parse_common_flags >] -> (DMacro,p) :: l + | [< '(Kwd Dynamic,p); l = parse_common_flags >] -> (DDynamic,p) :: l + | [< '(Kwd Inline,p); l = parse_common_flags >] -> (DInline,p) :: l + | [< '(Kwd Public,p); l = parse_common_flags >] -> (DPublic,p) :: l + | [< '(Kwd Static,p); l = parse_common_flags >] -> (DStatic,p) :: l + | [< '(Kwd Overload,p); l = parse_common_flags >] -> (DOverload,p) :: l | [< >] -> [] and parse_meta_argument_expr s = @@ -484,7 +560,7 @@ and parse_meta_entry = parser [< '(At,p1); s >] -> let meta = check_resume p1 (fun () -> Some (Meta.Last,[],p1)) (fun () -> None) in match s with parser - | [< name,p = parse_meta_name p1; params = parse_meta_params p; s >] -> (name,params,punion p1 p) + | [< name,p = parse_meta_name p1; params = parse_meta_params p >] -> (name,params,punion p1 p) | [< >] -> match meta with None -> serror() | Some meta -> meta and parse_meta = parser @@ -592,6 +668,13 @@ and parse_complex_type_inner allow_named = parser | [< >] -> serror()) | [< '(Question,p1); t,p2 = parse_complex_type_inner allow_named >] -> CTOptional (t,p2),punion p1 p2 + | [< '(Spread,p1); t,p2 = parse_complex_type_inner allow_named >] -> + let hint = + match t with + | CTNamed (_,hint) -> hint + | _ -> (t,p2) + in + CTPath (mk_type_path ~params:[TPType hint] (["haxe"],"Rest")),punion p1 p2 | [< n = dollar_ident; s >] -> (match s with parser | [< '(DblDot,_) when allow_named; t = parse_complex_type >] -> @@ -731,7 +814,7 @@ and parse_function_type_next tl p1 = parser and parse_type_anonymous s = let p0 = popt question_mark s in match s with parser - | [< name, p1 = ident; t = parse_type_hint; s >] -> + | [< name, p1 = dollar_ident; t = parse_type_hint; s >] -> let opt,p1 = match p0 with | Some p -> true,punion p p1 | None -> false,p1 @@ -903,6 +986,8 @@ and parse_cf_rights = parser | [< '(Kwd Dynamic,p) >] -> ADynamic,p | [< '(Kwd Inline,p) >] -> AInline,p | [< '(Kwd Extern,p) >] -> AExtern,p + | [< '(Kwd Abstract,p) >] -> AAbstract,p + | [< '(Kwd Overload,p) >] -> AOverload,p and parse_fun_name = parser | [< name,p = dollar_ident >] -> name,p @@ -913,6 +998,10 @@ and parse_fun_param s = match s with parser | [< '(Question,_); name, pn = dollar_ident; t = popt parse_type_hint; c = parse_fun_param_value >] -> ((name,pn),true,meta,t,c) | [< name, pn = dollar_ident; t = popt parse_type_hint; c = parse_fun_param_value >] -> ((name,pn),false,meta,t,c) + | [< '(Spread,_); name, pn = dollar_ident; t = popt parse_type_hint; c = parse_fun_param_value >] -> + let t = match t with Some t -> t | None -> (ct_mono,null_pos) in + let t = CTPath (mk_type_path ~params:[TPType t] (["haxe"],"Rest")), snd t in + ((name,pn),false,meta,Some t,c) and parse_fun_param_value = parser | [< '(Binop OpAssign,_); e = expr >] -> Some e @@ -1091,33 +1180,35 @@ and parse_array_decl p1 s = in EArrayDecl (List.rev el),punion p1 p2 -and parse_var_decl_head final = parser - | [< name, p = dollar_ident; t = popt parse_type_hint >] -> (name,final,t,p) +and parse_var_decl_head final s = + let meta = parse_meta s in + match s with parser + | [< name, p = dollar_ident; t = popt parse_type_hint >] -> (meta,name,final,t,p) and parse_var_assignment = parser | [< '(Binop OpAssign,p1); s >] -> Some (secure_expr s) | [< >] -> None -and parse_var_assignment_resume final vl name pn t s = +and parse_var_assignment_resume final vl name pn t meta s = let eo = parse_var_assignment s in - ((name,pn),final,t,eo) + mk_evar ~final ?t ?eo ~meta (name,pn) and parse_var_decls_next final vl = parser - | [< '(Comma,p1); name,final,t,pn = parse_var_decl_head final; s >] -> - let v_decl = parse_var_assignment_resume final vl name pn t s in + | [< '(Comma,p1); meta,name,final,t,pn = parse_var_decl_head final; s >] -> + let v_decl = parse_var_assignment_resume final vl name pn t meta s in parse_var_decls_next final (v_decl :: vl) s | [< >] -> vl and parse_var_decls final p1 = parser - | [< name,final,t,pn = parse_var_decl_head final; s >] -> - let v_decl = parse_var_assignment_resume final [] name pn t s in + | [< meta,name,final,t,pn = parse_var_decl_head final; s >] -> + let v_decl = parse_var_assignment_resume final [] name pn t meta s in List.rev (parse_var_decls_next final [v_decl] s) - | [< s >] -> error (Custom "Missing variable identifier") p1 + | [< >] -> error (Custom "Missing variable identifier") p1 and parse_var_decl final = parser - | [< name,final,t,pn = parse_var_decl_head final; v_decl = parse_var_assignment_resume final [] name pn t >] -> v_decl + | [< meta,name,final,t,pn = parse_var_decl_head final; v_decl = parse_var_assignment_resume final [] name pn t meta >] -> v_decl and inline_function = parser | [< '(Kwd Inline,_); '(Kwd Function,p1) >] -> true, p1 @@ -1236,9 +1327,6 @@ and expr = parser | [< t,pt = parse_type_hint; '(PClose,p2); s >] -> let ep = EParenthesis (ECheckType(e,(t,pt)),punion p1 p2), punion p1 p2 in expr_next (ECast (ep,None),punion p1 (pos ep)) s - | [< '(Const (Ident "is"),p_is); t = parse_type_path; '(PClose,p2); >] -> - let e_is = make_is e t (punion p1 p2) p_is in - expr_next (ECast (e_is,None),punion p1 (pos e_is)) s | [< '(PClose,p2); s >] -> let ep = expr_next (EParenthesis(e),punion pp p2) s in expr_next (ECast (ep,None),punion p1 (pos ep)) s @@ -1279,13 +1367,13 @@ and expr = parser with_args al er | [< >] -> serror()) | [< >] -> serror()) - | [< '(Const (Ident "is"),p_is); t = parse_type_path; '(PClose,p2); >] -> expr_next (make_is e t (punion p1 p2) p_is) s | [< >] -> - syntax_error (Expected [")";",";":";"is"]) s (expr_next (EParenthesis e, punion p1 (pos e)) s)) + syntax_error (Expected [")";",";":"]) s (expr_next (EParenthesis e, punion p1 (pos e)) s)) ) | [< '(BkOpen,p1); e = parse_array_decl p1; s >] -> expr_next e s | [< '(Kwd Function,p1); e = parse_function p1 false; >] -> e - | [< '(Unop op,p1) when is_prefix op; e = expr >] -> make_unop op e p1 + | [< '(Unop op,p1); e = expr >] -> make_unop op e p1 + | [< '(Spread,p1); e = expr >] -> make_unop Spread e (punion p1 (pos e)) | [< '(Binop OpSub,p1); e = expr >] -> make_unop Neg e p1 (*/* removed unary + : this cause too much syntax errors go unnoticed, such as "a + + 1" (missing 'b') @@ -1309,7 +1397,7 @@ and expr = parser syntax_error (Expected [")"]) s (mk_null_expr (pos cond)) in let e2 = (match s with parser - | [< '(Kwd Else,_); e2 = secure_expr; s >] -> Some e2 + | [< '(Kwd Else,_); e2 = secure_expr >] -> Some e2 | [< >] -> (* We check this in two steps to avoid the lexer missing tokens (#8565). *) match Stream.npeek 1 s with @@ -1405,6 +1493,7 @@ and expr_next' e1 = parser | [< e2 = secure_expr >] -> make_binop OpGt e1 e2) | [< '(Binop op,_); e2 = secure_expr >] -> make_binop op e1 e2 + | [< '(Spread,_); e2 = secure_expr >] -> make_binop OpInterval e1 e2 | [< '(Unop op,p) when is_postfix e1 op; s >] -> expr_next (EUnop (op,Postfix,e1), punion (pos e1) p) s | [< '(Question,_); e2 = expr; s >] -> @@ -1414,6 +1503,11 @@ and expr_next' e1 = parser end | [< '(Kwd In,_); e2 = expr >] -> make_binop OpIn e1 e2 + | [< '(Const (Ident "is"),p_is); t = parse_complex_type; s >] -> + let p1 = pos e1 in + let p2 = pos t in + let e_is = EIs (e1,t), (punion p1 p2) in + expr_next e_is s | [< >] -> e1 and parse_field e1 p s = @@ -1439,8 +1533,8 @@ and parse_guard = parser e and expr_or_var = parser - | [< '(Kwd Var,p1); name,p2 = dollar_ident; >] -> EVars [(name,p2),false,None,None],punion p1 p2 - | [< '(Kwd Final,p1); name,p2 = dollar_ident; >] -> EVars [(name,p2),true,None,None],punion p1 p2 + | [< '(Kwd Var,p1); np = dollar_ident; >] -> EVars [mk_evar np],punion p1 (snd np) + | [< '(Kwd Final,p1); np = dollar_ident; >] -> EVars [mk_evar ~final:true np],punion p1 (snd np) | [< e = secure_expr >] -> e and parse_switch_cases eswitch cases = parser diff --git a/src/syntax/lexer.ml b/src/syntax/lexer.ml index 641c8c48..6a56ecc1 100644 --- a/src/syntax/lexer.ml +++ b/src/syntax/lexer.ml @@ -58,7 +58,6 @@ type lexer_file = { mutable lmaxline : int; mutable llines : (int * int) list; mutable lalines : (int * int) array; - mutable lstrings : int list; mutable llast : int; mutable llastindex : int; } @@ -70,7 +69,6 @@ let make_file file = lmaxline = 1; llines = [0,1]; lalines = [|0,1|]; - lstrings = []; llast = max_int; llastindex = 0; } @@ -129,37 +127,6 @@ let newline lexbuf = cur.lline <- cur.lline + 1; cur.llines <- (lexeme_end lexbuf,cur.lline) :: cur.llines -let fmt_pos p = - p.pmin + (p.pmax - p.pmin) * 1000000 - -let add_fmt_string p = - let file = (try - Hashtbl.find all_files p.pfile - with Not_found -> - let f = make_file p.pfile in - Hashtbl.replace all_files p.pfile f; - f - ) in - file.lstrings <- (fmt_pos p) :: file.lstrings - -let fast_add_fmt_string p = - let cur = !cur in - cur.lstrings <- (fmt_pos p) :: cur.lstrings - -let is_fmt_string p = - try - let file = Hashtbl.find all_files p.pfile in - List.mem (fmt_pos p) file.lstrings - with Not_found -> - false - -let remove_fmt_string p = - try - let file = Hashtbl.find all_files p.pfile in - file.lstrings <- List.filter ((<>) (fmt_pos p)) file.lstrings - with Not_found -> - () - let find_line p f = (* rebuild cache if we have a new line *) if f.lmaxline <> f.lline then begin @@ -316,6 +283,20 @@ let sharp_ident = [%sedlex.regexp? ) ] +let is_whitespace = function + | ' ' | '\n' | '\r' | '\t' -> true + | _ -> false + +let string_is_whitespace s = + try + for i = 0 to String.length s - 1 do + if not (is_whitespace (String.unsafe_get s i)) then + raise Exit + done; + true + with Exit -> + false + let idtype = [%sedlex.regexp? Star '_', 'A'..'Z', Star ('_' | 'a'..'z' | 'A'..'Z' | '0'..'9')] let integer = [%sedlex.regexp? ('1'..'9', Star ('0'..'9')) | '0'] @@ -374,7 +355,7 @@ let rec token lexbuf = | "||" -> mk lexbuf (Binop OpBoolOr) | "<<" -> mk lexbuf (Binop OpShl) | "->" -> mk lexbuf Arrow - | "..." -> mk lexbuf (Binop OpInterval) + | "..." -> mk lexbuf Spread | "=>" -> mk lexbuf (Binop OpArrow) | "!" -> mk lexbuf (Unop Not) | "<" -> mk lexbuf (Binop OpLt) @@ -417,9 +398,7 @@ let rec token lexbuf = let pmin = lexeme_start lexbuf in let pmax = (try string2 lexbuf with Exit -> error Unterminated_string pmin) in let str = (try unescape (contents()) with Invalid_escape_sequence(c,i,msg) -> error (Invalid_escape (c,msg)) (pmin + i)) in - let t = mk_tok (Const (String(str,SSingleQuotes))) pmin pmax in - fast_add_fmt_string (snd t); - t + mk_tok (Const (String(str,SSingleQuotes))) pmin pmax; | "~/" -> reset(); let pmin = lexeme_start lexbuf in @@ -544,9 +523,8 @@ and code_string lexbuf open_braces = | "'" -> add "'"; let pmin = lexeme_start lexbuf in - let pmax = (try string2 lexbuf with Exit -> error Unterminated_string pmin) in + (try ignore(string2 lexbuf) with Exit -> error Unterminated_string pmin); add "'"; - fast_add_fmt_string { pfile = !cur.lfile; pmin = pmin; pmax = pmax }; code_string lexbuf open_braces | "/*" -> let pmin = lexeme_start lexbuf in @@ -634,6 +612,11 @@ let rec sharp_token lexbuf = | Plus (Chars " \t") -> sharp_token lexbuf | "\r\n" -> newline lexbuf; sharp_token lexbuf | '\n' | '\r' -> newline lexbuf; sharp_token lexbuf + | "/*" -> + reset(); + let pmin = lexeme_start lexbuf in + ignore(try comment lexbuf with Exit -> error Unclosed_comment pmin); + sharp_token lexbuf | _ -> token lexbuf let lex_xml p lexbuf = diff --git a/src/syntax/parser.ml b/src/syntax/parser.ml index b43b8889..7942c232 100644 --- a/src/syntax/parser.ml +++ b/src/syntax/parser.ml @@ -38,6 +38,12 @@ type decl_flag = | DPrivate | DExtern | DFinal + | DMacro + | DDynamic + | DInline + | DPublic + | DStatic + | DOverload type type_decl_completion_mode = | TCBeforePackage @@ -87,6 +93,17 @@ type 'a parse_result = (* Parsed non-display file with errors *) | ParseError of 'a * parse_error * parse_error list +let s_decl_flag = function + | DPrivate -> "private" + | DExtern -> "extern" + | DFinal -> "final" + | DMacro -> "macro" + | DDynamic -> "dynamic" + | DInline -> "inline" + | DPublic -> "public" + | DStatic -> "static" + | DOverload -> "overload" + let syntax_completion kind so p = raise (SyntaxCompletion(kind,DisplayTypes.make_subject so p)) @@ -94,21 +111,6 @@ let error m p = raise (Error (m,p)) let special_identifier_files : (Path.UniqueKey.t,string) Hashtbl.t = Hashtbl.create 0 -let decl_flag_to_class_flag (flag,p) = match flag with - | DPrivate -> HPrivate - | DExtern -> HExtern - | DFinal -> HFinal - -let decl_flag_to_enum_flag (flag,p) = match flag with - | DPrivate -> EPrivate - | DExtern -> EExtern - | DFinal -> error (Custom "final on enums is not allowed") p - -let decl_flag_to_abstract_flag (flag,p) = match flag with - | DPrivate -> AbPrivate - | DExtern -> AbExtern - | DFinal -> error (Custom "final on abstracts is not allowed") p - module TokenCache = struct let cache = ref (DynArray.create ()) let add (token : (token * pos)) = DynArray.add (!cache) token @@ -161,13 +163,16 @@ let in_display_file = ref false let last_doc : (string * int) option ref = ref None let syntax_errors = ref [] -let syntax_error error_msg ?(pos=None) s v = - let p = (match pos with Some p -> p | None -> next_pos s) in +let syntax_error_with_pos error_msg p v = let p = if p.pmax = max_int then {p with pmax = p.pmin + 1} else p in if not !in_display then error error_msg p; syntax_errors := (error_msg,p) :: !syntax_errors; v +let syntax_error error_msg ?(pos=None) s v = + let p = (match pos with Some p -> p | None -> next_pos s) in + syntax_error_with_pos error_msg p v + let handle_stream_error msg s = let err,pos = if msg = "" then begin let tk,pos = next_token s in @@ -188,6 +193,40 @@ let get_doc s = last_doc := None; if pos = p.pmin then Some d else None +let unsupported_decl_flag decl flag pos = + let msg = (s_decl_flag flag) ^ " modifier is not supported for " ^ decl in + syntax_error_with_pos (Custom msg) pos None + +let unsupported_decl_flag_class = unsupported_decl_flag "classes" +let unsupported_decl_flag_enum = unsupported_decl_flag "enums" +let unsupported_decl_flag_abstract = unsupported_decl_flag "abstracts" +let unsupported_decl_flag_module_field = unsupported_decl_flag "module-level fields" + +let decl_flag_to_class_flag (flag,p) = match flag with + | DPrivate -> Some HPrivate + | DExtern -> Some HExtern + | DFinal -> Some HFinal + | DMacro | DDynamic | DInline | DPublic | DStatic | DOverload -> unsupported_decl_flag_class flag p + +let decl_flag_to_enum_flag (flag,p) = match flag with + | DPrivate -> Some EPrivate + | DExtern -> Some EExtern + | DFinal | DMacro | DDynamic | DInline | DPublic | DStatic | DOverload -> unsupported_decl_flag_enum flag p + +let decl_flag_to_abstract_flag (flag,p) = match flag with + | DPrivate -> Some AbPrivate + | DExtern -> Some AbExtern + | DFinal | DMacro | DDynamic | DInline | DPublic | DStatic | DOverload -> unsupported_decl_flag_abstract flag p + +let decl_flag_to_module_field_flag (flag,p) = match flag with + | DPrivate -> Some (APrivate,p) + | DMacro -> Some (AMacro,p) + | DDynamic -> Some (ADynamic,p) + | DInline -> Some (AInline,p) + | DOverload -> Some (AOverload,p) + | DExtern -> Some (AExtern,p) + | DFinal | DPublic | DStatic -> unsupported_decl_flag_module_field flag p + let serror() = raise (Stream.Error "") let magic_display_field_name = " - display - " @@ -261,6 +300,7 @@ let rec make_unop op ((v,p2) as e) p1 = match v with | EBinop (bop,e,e2) -> EBinop (bop, make_unop op e p1 , e2) , (punion p1 p2) | ETernary (e1,e2,e3) -> ETernary (make_unop op e1 p1 , e2, e3), punion p1 p2 + | EIs (e, t) -> EIs (make_unop op e p1, t), punion p1 p2 | EConst (Int i) when op = Neg -> EConst (Int (neg i)),punion p1 p2 | EConst (Float j) when op = Neg -> EConst (Float (neg j)),punion p1 p2 | _ -> EUnop (op,Prefix,e), punion p1 p2 @@ -272,11 +312,6 @@ let rec make_meta name params ((v,p2) as e) p1 = | ETernary (e1,e2,e3) -> ETernary (make_meta name params e1 p1 , e2, e3), punion p1 p2 | _ -> EMeta((name,params,p1),e),punion p1 p2 -let make_is e (t,p_t) p p_is = - let e_is = EField((EConst(Ident "Std"),null_pos),"isOfType"),p_is in - let e2 = expr_of_type_path (t.tpackage,t.tname) p_t in - ECall(e_is,[e;e2]),p - let handle_xml_literal p1 = Lexer.reset(); let i = Lexer.lex_xml p1.pmin !code_ref in @@ -381,4 +416,7 @@ let check_signature_mark e p1 p2 = if (display_position#get).pmin = p1.pmax then (mk_display_expr e DKMarked) else e end - end \ No newline at end of file + end + +let convert_abstract_flags flags = + ExtList.List.filter_map decl_flag_to_abstract_flag flags \ No newline at end of file diff --git a/src/syntax/parserEntry.ml b/src/syntax/parserEntry.ml index b34a418e..e3188616 100644 --- a/src/syntax/parserEntry.ml +++ b/src/syntax/parserEntry.ml @@ -204,7 +204,7 @@ class dead_block_collector conds = object(self) end (* parse main *) -let parse ctx code file = +let parse entry ctx code file = let old = Lexer.save() in let restore_cache = TokenCache.clear () in let was_display = !in_display in @@ -213,7 +213,7 @@ let parse ctx code file = let old_macro = !in_macro in code_ref := code; in_display := display_position#get <> null_pos; - in_display_file := !in_display && display_position#is_in_file file; + in_display_file := !in_display && display_position#is_in_file (Path.UniqueKey.create file); syntax_errors := []; let restore = (fun () -> @@ -360,7 +360,7 @@ let parse ctx code file = Some t ) in try - let l = parse_file s in + let l = entry s in (match !mstack with p :: _ -> syntax_error Unclosed_conditional ~pos:(Some p) sraw () | _ -> ()); let was_display_file = !in_display_file in restore(); @@ -384,7 +384,7 @@ let parse ctx code file = restore(); raise e -let parse_string com s p error inlined = +let parse_string entry com s p error inlined = let old = Lexer.save() in let old_file = (try Some (Hashtbl.find Lexer.all_files p.pfile) with Not_found -> None) in let old_display = display_position#get in @@ -409,7 +409,7 @@ let parse_string com s p error inlined = in_display_file := false; end; let result = try - parse com (Sedlexing.Utf8.from_string s) p.pfile + parse entry com (Sedlexing.Utf8.from_string s) p.pfile with Error (e,pe) -> restore(); error (error_msg e) (if inlined then pe else p) @@ -421,13 +421,16 @@ let parse_string com s p error inlined = result let parse_expr_string com s p error inl = - let head = "class X{static function main() " in - let head = (if p.pmin > String.length head then head ^ String.make (p.pmin - String.length head) ' ' else head) in - let rec loop e = let e = Ast.map_expr loop e in (fst e,p) in - let extract_expr (_,decls) = match decls with - | [EClass { d_data = [{ cff_name = "main",null_pos; cff_kind = FFun { f_expr = Some e } }]},_] -> (if inl then e else loop e) - | _ -> raise Exit - in - match parse_string com (head ^ s ^ ";}") p error inl with - | ParseSuccess(data,is_display_file,pdi) -> ParseSuccess(extract_expr data,is_display_file,pdi) - | ParseError(data,error,errors) -> ParseError(extract_expr data,error,errors) + let s = if p.pmin > 0 then (String.make p.pmin ' ') ^ s else s in + let result = parse_string expr com s p error inl in + if inl then + result + else begin + let rec loop e = + let e = map_expr loop e in + (fst e,p) + in + match result with + | ParseSuccess(data,is_display_file,pdi) -> ParseSuccess(loop data,is_display_file,pdi) + | ParseError(data,error,errors) -> ParseError(loop data,error,errors) + end diff --git a/src/syntax/reification.ml b/src/syntax/reification.ml index d9987ac9..af283b38 100644 --- a/src/syntax/reification.ml +++ b/src/syntax/reification.ml @@ -182,6 +182,8 @@ let reify in_macro = | AMacro -> "AMacro" | AFinal -> "AFinal" | AExtern -> "AExtern" + | AAbstract -> "AAbstract" + | AOverload -> "AOverload" ) in mk_enum "Access" n [] p in @@ -224,6 +226,11 @@ let reify in_macro = (EUntyped (ECall ((EConst (Ident "$__mk_pos__"),p),[file;pmin;pmax]),p),p) else to_obj [("file",file);("min",pmin);("max",pmax)] p + and to_enc_pos p = + match !cur_pos with + | Some p -> p + | None when in_macro -> to_pos p + | None -> (ECall ((EField ((EField ((EField ((EConst (Ident "haxe"),p),"macro"),p),"Context"),p),"makePosition"),p),[to_pos p]),p) and to_expr_array a p = match a with | [EMeta ((Meta.Dollar "a",[],_),e1),_] -> (match fst e1 with EArrayDecl el -> to_expr_array el p | _ -> e1) | _ -> to_array to_expr a p @@ -270,15 +277,17 @@ let reify in_macro = | Not -> "OpNot" | Neg -> "OpNeg" | NegBits -> "OpNegBits" + | Spread -> "OpSpread" ) [] p in expr "EUnop" [op;to_bool (flag = Postfix) p;loop e] | EVars vl -> - expr "EVars" [to_array (fun ((n,pn),final,th,e) p -> + expr "EVars" [to_array (fun v p -> let fields = [ - "name", to_string n pn; - "type", to_opt to_type_hint th p; - "expr", to_opt to_expr e p; - "isFinal",to_bool final p; + "name", to_string (fst v.ev_name) (snd v.ev_name); + "type", to_opt to_type_hint v.ev_type p; + "expr", to_opt to_expr v.ev_expr p; + "isFinal",to_bool v.ev_final p; + "meta",to_meta v.ev_meta p; ] in to_obj fields p ) vl p] @@ -320,6 +329,8 @@ let reify in_macro = expr "EThrow" [loop e] | ECast (e,ct) -> expr "ECast" [loop e; to_opt to_type_hint ct p] + | EIs (e,ct) -> + expr "EIs" [loop e; to_type_hint ct p] | EDisplay (e,dk) -> expr "EDisplay" [loop e; to_display_kind dk p] | EDisplayNew t -> @@ -342,7 +353,7 @@ let reify in_macro = | EParenthesis (ECheckType (e2, (CTPath{tname="String";tpackage=[]},_)),_) -> expr "EConst" [mk_enum "Constant" "CString" [e2] (pos e2)] | EParenthesis (ECheckType (e2, (CTPath{tname="Int";tpackage=[]},_)),_) -> expr "EConst" [mk_enum "Constant" "CInt" [e2] (pos e2)] | EParenthesis (ECheckType (e2, (CTPath{tname="Float";tpackage=[]},_)),_) -> expr "EConst" [mk_enum "Constant" "CFloat" [e2] (pos e2)] - | _ -> (ECall ((EField ((EField ((EField ((EConst (Ident "haxe"),p),"macro"),p),"Context"),p),"makeExpr"),p),[e; to_pos (pos e)]),p) + | _ -> (ECall ((EField ((EField ((EField ((EConst (Ident "haxe"),p),"macro"),p),"Context"),p),"makeExpr"),p),[e; to_enc_pos (pos e)]),p) end | Meta.Dollar "i", _ -> expr "EConst" [mk_enum "Constant" "CIdent" [e1] (pos e1)] @@ -360,12 +371,13 @@ let reify in_macro = to_obj [ "name", to_placed_name t.tp_name; "params", (EArrayDecl (List.map (to_tparam_decl p) t.tp_params),p); + "meta", to_meta t.tp_meta p; "constraints", (EArrayDecl (match t.tp_constraints with None -> [] | Some th -> [to_ctype th p]),p) ] p and to_type_def (t,p) = match t with | EClass d -> - let ext = ref None and impl = ref [] and interf = ref false and final = ref false in + let ext = ref None and impl = ref [] and interf = ref false and final = ref false and abstract = ref false in List.iter (function | HExtern | HPrivate -> () | HInterface -> interf := true; @@ -377,6 +389,7 @@ let reify in_macro = end) | HImplements i-> impl := (to_tpath i p) :: !impl | HFinal -> final := true + | HAbstract -> abstract := true ) d.d_flags; to_obj [ "pack", (EArrayDecl [],p); @@ -385,7 +398,7 @@ let reify in_macro = "meta", to_meta d.d_meta p; "params", (EArrayDecl (List.map (to_tparam_decl p) d.d_params),p); "isExtern", to_bool (List.mem HExtern d.d_flags) p; - "kind", mk_enum "TypeDefKind" "TDClass" [(match !ext with None -> (EConst (Ident "null"),p) | Some t -> t);(EArrayDecl (List.rev !impl),p);to_bool !interf p;to_bool !final p] p; + "kind", mk_enum "TypeDefKind" "TDClass" [(match !ext with None -> (EConst (Ident "null"),p) | Some t -> t);(EArrayDecl (List.rev !impl),p);to_bool !interf p;to_bool !final p;to_bool !abstract p] p; "fields", (EArrayDecl (List.map (fun f -> to_cfield f p) d.d_data),p) ] p | _ -> die "" __LOC__ diff --git a/src/typing/callUnification.ml b/src/typing/callUnification.ml new file mode 100644 index 00000000..ee3f43a5 --- /dev/null +++ b/src/typing/callUnification.ml @@ -0,0 +1,617 @@ +open Globals +open Ast +open Type +open Typecore +open Error +open FieldAccess + +let is_forced_inline c cf = + match c with + | Some { cl_kind = KAbstractImpl _ } -> true + | Some c when has_class_flag c CExtern -> true + | _ when has_class_field_flag cf CfExtern -> true + | _ -> false + +let relative_path ctx file = + let slashes path = String.concat "/" (ExtString.String.nsplit path "\\") in + let fpath = slashes (Path.get_full_path file) in + let fpath_lower = String.lowercase fpath in + let flen = String.length fpath_lower in + let rec loop = function + | [] -> file + | path :: l -> + let spath = String.lowercase (slashes path) in + let slen = String.length spath in + if slen > 0 && slen < flen && String.sub fpath_lower 0 slen = spath then String.sub fpath slen (flen - slen) else loop l + in + loop ctx.com.Common.class_path + +let mk_infos ctx p params = + let file = if ctx.in_macro then p.pfile else if Common.defined ctx.com Define.AbsolutePath then Path.get_full_path p.pfile else relative_path ctx p.pfile in + (EObjectDecl ( + (("fileName",null_pos,NoQuotes) , (EConst (String(file,SDoubleQuotes)) , p)) :: + (("lineNumber",null_pos,NoQuotes) , (EConst (Int (string_of_int (Lexer.get_error_line p))),p)) :: + (("className",null_pos,NoQuotes) , (EConst (String (s_type_path ctx.curclass.cl_path,SDoubleQuotes)),p)) :: + if ctx.curfield.cf_name = "" then + params + else + (("methodName",null_pos,NoQuotes), (EConst (String (ctx.curfield.cf_name,SDoubleQuotes)),p)) :: params + ) ,p) + +let rec is_pos_infos = function + | TMono r -> + (match r.tm_type with + | Some t -> is_pos_infos t + | _ -> false) + | TLazy f -> + is_pos_infos (lazy_type f) + | TType ({ t_path = ["haxe"] , "PosInfos" },[]) -> + true + | TType (t,tl) -> + is_pos_infos (apply_params t.t_params tl t.t_type) + | TAbstract({a_path=[],"Null"},[t]) -> + is_pos_infos t + | _ -> + false + +let rec unify_call_args ctx el args r callp inline force_inline in_overload = + let call_error err p = + raise (Error (Call_error err,p)) + in + let arg_error ul name opt p = + let err = Stack (ul,Custom ("For " ^ (if opt then "optional " else "") ^ "function argument '" ^ name ^ "'")) in + call_error (Could_not_unify err) p + in + let mk_pos_infos t = + let infos = mk_infos ctx callp [] in + type_expr ctx infos (WithType.with_type t) + in + let rec default_value name t = + if is_pos_infos t then + mk_pos_infos t + else + null (ctx.t.tnull t) callp + in + let skipped = ref [] in + let invalid_skips = ref [] in + let skip name ul t p = + if not ctx.com.config.pf_can_skip_non_nullable_argument && not (is_nullable t) then + invalid_skips := name :: !invalid_skips; + skipped := (name,ul,p) :: !skipped; + default_value name t + in + (* let force_inline, is_extern = match cf with Some(TInst(c,_),f) -> is_forced_inline (Some c) f, (has_class_flag c CExtern) | _ -> false, false in *) + let type_against name t e = + try + let e = type_expr ctx e (WithType.with_argument t name) in + !cast_or_unify_raise_ref ctx t e e.epos + with Error(l,p) when (match l with Call_error _ | Module_not_found _ -> false | _ -> true) -> + raise (WithTypeError (l,p)) + in + let rec loop el args = match el,args with + | [],[] -> + begin match List.rev !invalid_skips with + | [] -> () + | name :: _ -> call_error (Cannot_skip_non_nullable name) callp; + end; + [] + | _,[name,false,TAbstract({ a_path = ["cpp"],"Rest" },[t])] -> + (try List.map (fun e -> type_against name t e) el + with WithTypeError(ul,p) -> arg_error ul name false p) + | _,[name,false,t] when ExtType.is_rest (follow t) -> + begin match follow t with + | TAbstract({a_path=(["haxe"],"Rest")},[arg_t]) -> + let unexpected_spread p = + arg_error (Custom "Cannot spread arguments with additional rest arguments") name false p + in + (* these platforms deal with rest args on their own *) + if ctx.com.config.pf_supports_rest_args then + match el with + | [(EUnop (Spread,Prefix,e),p)] -> + (try [mk (TUnop (Spread, Prefix, type_against name t e)) t p] + with WithTypeError(ul,p) -> arg_error ul name false p) + | _ -> + (try + List.map (fun e -> + match e with + | (EUnop (Spread,Prefix,_),p) -> + unexpected_spread p + | _ -> type_against name arg_t e + ) el + with WithTypeError(ul,p) -> + arg_error ul name false p) + (* for other platforms make sure rest arguments are wrapped in an array *) + else begin + match el with + | [(EUnop (Spread,Prefix,e),p)] -> + (try [type_against name t e] + with WithTypeError(ul,p) -> arg_error ul name false p) + | [] -> + (try [type_against name t (EArrayDecl [],callp)] + with WithTypeError(ul,p) -> arg_error ul name false p) + | (_,p1) :: _ -> + let p = + List.fold_left (fun p (e1,p2) -> + match e1 with + | EUnop (Spread,Prefix,_) -> unexpected_spread p2 + | _ -> punion p p2 + ) p1 el + in + (try + let do_type e = [type_against name t e] in + let e = EArrayDecl el,p in + (* typer requires dynamic arrays to be explicitly declared as Array *) + if follow arg_t == t_dynamic then begin + let dynamic = CTPath(mk_type_path ([],"Dynamic")),p in + let params = [TPType dynamic] in + let tp = mk_type_path ~params ([],"Array") in + do_type (ECheckType(e,(CTPath tp, p)),p) (* ([arg1, arg2...]:Array) *) + end else + do_type e + with WithTypeError(ul,p) -> + arg_error ul name false p + ) + end + | _ -> + die "" __LOC__ + end + | [],(_,false,_) :: _ -> + call_error (Not_enough_arguments args) callp + | [],(name,true,t) :: args -> + begin match loop [] args with + | [] when not (inline && (ctx.g.doinline || force_inline)) && not ctx.com.config.pf_pad_nulls -> + if is_pos_infos t then [mk_pos_infos t] + else [] + | args -> + let e_def = default_value name t in + e_def :: args + end + | (e,p) :: el, [] -> + begin match List.rev !skipped with + | [] -> + if ctx.is_display_file && not (Diagnostics.is_diagnostics_run ctx.com p) then begin + ignore(type_expr ctx (e,p) WithType.value); + ignore(loop el []) + end; + call_error Too_many_arguments p + | (s,ul,p) :: _ -> arg_error ul s true p + end + | e :: el,(name,opt,t) :: args -> + begin try + let e = type_against name t e in + e :: loop el args + with + WithTypeError (ul,p)-> + if opt && List.length el < List.length args then + let e_def = skip name ul t p in + e_def :: loop (e :: el) args + else + match List.rev !skipped with + | [] -> arg_error ul name opt p + | (s,ul,p) :: _ -> arg_error ul s true p + end + in + let restore = + let in_call_args = ctx.in_call_args in + let in_overload_call_args = ctx.in_overload_call_args in + ctx.in_call_args <- true; + ctx.in_overload_call_args <- in_overload; + (fun () -> + ctx.in_call_args <- in_call_args; + ctx.in_overload_call_args <- in_overload_call_args; + ) + in + let el = try loop el args with exc -> restore(); raise exc; in + restore(); + el,TFun(args,r) + +type overload_kind = + | OverloadProper (* @:overload or overload *) + | OverloadMeta (* @:overload(function() {}) *) + | OverloadNone + +let unify_field_call ctx fa el_typed el p inline = + let expand_overloads cf = + cf :: cf.cf_overloads + in + let candidates,co,static,map,tmap = match fa.fa_host with + | FHStatic c -> + expand_overloads fa.fa_field,Some c,true,(fun t -> t),(fun t -> t) + | FHAnon -> + expand_overloads fa.fa_field,None,false,(fun t -> t),(fun t -> t) + | FHInstance(c,tl) -> + let cf = fa.fa_field in + let cfl = if cf.cf_name = "new" || not (has_class_field_flag cf CfOverload) then + cf :: cf.cf_overloads + else + List.map (fun (t,cf) -> + cf + ) (Overloads.get_overloads ctx.com c cf.cf_name) + in + cfl,Some c,false,TClass.get_map_function c tl,(fun t -> t) + | FHAbstract(a,tl,c) -> + let map = apply_params a.a_params tl in + let tmap = if fa.fa_field.cf_name = "_new" (* TODO: BAD BAD BAD BAD *) then (fun t -> t) else (fun t -> map a.a_this) in + expand_overloads fa.fa_field,Some c,true,map,tmap + in + let is_forced_inline = is_forced_inline co fa.fa_field in + let overload_kind = if has_class_field_flag fa.fa_field CfOverload then OverloadProper + else if fa.fa_field.cf_overloads <> [] then OverloadMeta + else OverloadNone + in + (* Delayed display handling works like this: If ctx.in_overload_call_args is set (via attempt_calls calling unify_call_args' below), + the code which normally raises eager Display exceptions (in typerDisplay.ml handle_display) instead stores them in ctx.delayed_display. + The overload handling here extracts them and associates the exception with the field call candidates. Afterwards, normal overload resolution + can take place and only then the display callback is actually committed. + *) + let extract_delayed_display () = match ctx.delayed_display with + | Some f -> + ctx.delayed_display <- None; + Some f + | None -> + None + in + let raise_augmented_display_exception cf de = + let default () = raise (DisplayException.DisplayException de) in + let javadoc = match gen_doc_text_opt cf.cf_doc with + | None -> default() + | Some s -> new Javadoc.javadoc s + in + match de with + | DisplayHover (Some hover) -> + begin match hover.hexpected with + | Some (WithType(t,Some si)) -> + let si = match si with + | FunctionArgument ({si_doc = None} as si) -> + WithType.FunctionArgument {si with si_doc = javadoc#get_param_info si.si_name}; + | StructureField ({si_doc = None} as si) -> + WithType.StructureField {si with si_doc = javadoc#get_param_info si.si_name}; + | _ -> + si + in + let expected = WithType.WithType(t,Some si) in + DisplayException.raise_hover hover.hitem (Some expected) hover.hpos + | _ -> + default() + end + | _ -> + default() + in + let commit_delayed_display fcc = + Option.may (fun de -> + raise_augmented_display_exception fcc.fc_field de; + ) (snd fcc.fc_data); + {fcc with fc_data = fst fcc.fc_data} + in + let attempt_call cf in_overload = + let monos = Monomorph.spawn_constrained_monos map cf.cf_params in + let t = map (apply_params cf.cf_params monos cf.cf_type) in + match follow t with + | TFun(args,ret) -> + let rec loop acc_el acc_args tmap args el_typed = match args,el_typed with + | ((_,opt,t0) as arg) :: args,e :: el_typed -> + begin try + unify_raise ctx (tmap e.etype) t0 e.epos; + with Error(Unify _ as msg,p) -> + let call_error = Call_error(Could_not_unify msg) in + raise(Error(call_error,p)) + end; + loop (e :: acc_el) (arg :: acc_args) (fun t -> t) args el_typed + | [],_ :: _ -> + let call_error = Call_error(Too_many_arguments) in + raise(Error(call_error,p)) + | _ -> + List.rev acc_el,List.rev acc_args,args + in + let el_typed,args_typed,args = loop [] [] tmap args el_typed in + let el,_ = + try + unify_call_args ctx el args ret p inline is_forced_inline in_overload + with DisplayException.DisplayException de -> + raise_augmented_display_exception cf de; + in + (* here *) + let el = el_typed @ el in + let tf = TFun(args_typed @ args,ret) in + let mk_call () = + let ef = mk (TField(fa.fa_on,FieldAccess.apply_fa cf fa.fa_host)) t fa.fa_pos in + !make_call_ref ctx ef el ret ~force_inline:inline p + in + make_field_call_candidate el ret monos tf cf (mk_call,extract_delayed_display()) + | t -> + error (s_type (print_context()) t ^ " cannot be called") p + in + let maybe_raise_unknown_ident cerr p = + let rec loop err = + match err with + | Unknown_ident _ -> error (error_msg err) p + | Stack (e1,e2) -> (loop e1; loop e2) + | _ -> () + in + match cerr with Could_not_unify err -> loop err | _ -> () + in + let attempt_calls candidates = + let rec loop candidates = match candidates with + | [] -> [],[] + | cf :: candidates -> + let known_monos = List.map (fun (m,_) -> + m,m.tm_type,m.tm_constraints + ) ctx.monomorphs.perfunction in + let current_monos = ctx.monomorphs.perfunction in + begin try + let candidate = attempt_call cf true in + ctx.monomorphs.perfunction <- current_monos; + if overload_kind = OverloadProper then begin + let candidates,failures = loop candidates in + candidate :: candidates,failures + end else + [candidate],[] + with Error ((Call_error cerr as err),p) -> + List.iter (fun (m,t,constr) -> + if t != m.tm_type then m.tm_type <- t; + if constr != m.tm_constraints then m.tm_constraints <- constr; + ) known_monos; + ctx.monomorphs.perfunction <- current_monos; + maybe_raise_unknown_ident cerr p; + let candidates,failures = loop candidates in + candidates,(cf,err,p,extract_delayed_display()) :: failures + end + in + loop candidates + in + let fail_fun () = + let tf = TFun(List.map (fun _ -> ("",false,t_dynamic)) el,t_dynamic) in + let call () = + let ef = mk (TField(fa.fa_on,FieldAccess.apply_fa fa.fa_field fa.fa_host)) tf fa.fa_pos in + mk (TCall(ef,[])) t_dynamic p + in + make_field_call_candidate [] t_dynamic [] tf fa.fa_field call + in + let maybe_check_access cf = + (* type_field doesn't check access for overloads, so let's check it here *) + begin match co with + | Some c -> + check_field_access ctx c cf static p; + | None -> + () + end; + in + match candidates with + | [cf] -> + if overload_kind = OverloadProper then maybe_check_access cf; + begin try + commit_delayed_display (attempt_call cf false) + with Error _ when ctx.com.display.dms_error_policy = EPIgnore -> + fail_fun(); + end + | _ -> + let candidates,failures = attempt_calls candidates in + let fail () = + let failures = List.map (fun (cf,err,p,delayed_display) -> + (* If any resolution attempt had a delayed display result, we might as well raise it now. *) + Option.may (fun de -> + raise_augmented_display_exception cf de; + ) delayed_display; + cf,error_msg err,p + ) failures in + let failures = remove_duplicates (fun (_,msg1,_) (_,msg2,_) -> msg1 <> msg2) failures in + begin match failures with + | [_,msg,p] -> + error msg p + | _ -> + display_error ctx "Could not find a suitable overload, reasons follow" p; + List.iter (fun (cf,msg,p2) -> + display_error ctx ("Overload resolution failed for " ^ (s_type (print_context()) cf.cf_type)) p; + display_error ctx msg p2; + ) failures; + error "End of overload failure reasons" p + end + in + if overload_kind = OverloadProper then begin match Overloads.Resolution.reduce_compatible candidates with + | [] -> fail() + | [fcc] -> + maybe_check_access fcc.fc_field; + commit_delayed_display fcc + | fcc :: l -> + display_error ctx "Ambiguous overload, candidates follow" p; + let st = s_type (print_context()) in + List.iter (fun fcc -> + display_error ctx (Printf.sprintf "... %s" (st fcc.fc_type)) fcc.fc_field.cf_name_pos; + ) (fcc :: l); + commit_delayed_display fcc + end else begin match List.rev candidates with + | [] -> fail() + | fcc :: _ -> commit_delayed_display fcc + end + +class call_dispatcher + (ctx : typer) + (mode : access_mode) + (with_type : WithType.t) + (p : pos) += + let is_set = match mode with MSet _ -> true | _ -> false in + let check_assign () = if is_set && ctx.com.display.dms_error_policy <> EPIgnore then invalid_assign p in + +object(self) + + method private make_field_call (fa : field_access) (el_typed : texpr list) (el : expr list) = + let fcc = unify_field_call ctx fa el_typed el p fa.fa_inline in + if has_class_field_flag fcc.fc_field CfAbstract then begin match fa.fa_on.eexpr with + | TConst TSuper -> display_error ctx (Printf.sprintf "abstract method %s cannot be accessed directly" fcc.fc_field.cf_name) p; + | _ -> () + end; + fcc.fc_data() + + method private macro_call (ethis : texpr) (cf : tclass_field) (el : expr list) = + if ctx.macro_depth > 300 then error "Stack overflow" p; + ctx.macro_depth <- ctx.macro_depth + 1; + ctx.with_type_stack <- with_type :: ctx.with_type_stack; + let ethis_f = ref (fun () -> ()) in + let f = (match ethis.eexpr with + | TTypeExpr (TClassDecl c) -> + DeprecationCheck.check_cf ctx.com cf p; + (match ctx.g.do_macro ctx MExpr c.cl_path cf.cf_name el p with + | None -> (fun() -> type_expr ~mode ctx (EConst (Ident "null"),p) WithType.value) + | Some (EMeta((Meta.MergeBlock,_,_),(EBlock el,_)),_) -> (fun () -> let e = (!type_block_ref) ctx el with_type p in mk (TMeta((Meta.MergeBlock,[],p), e)) e.etype e.epos) + | Some e -> (fun() -> type_expr ~mode ctx e with_type)) + | _ -> + (* member-macro call : since we will make a static call, let's find the actual class and not its subclass *) + (match follow ethis.etype with + | TInst (c,_) -> + let rec loop c = + if PMap.mem cf.cf_name c.cl_fields then + let eparam,f = push_this ctx ethis in + ethis_f := f; + let e = match ctx.g.do_macro ctx MExpr c.cl_path cf.cf_name (eparam :: el) p with + | None -> (fun() -> type_expr ~mode ctx (EConst (Ident "null"),p) WithType.value) + | Some e -> (fun() -> type_expr ~mode ctx e WithType.value) + in + e + else + match c.cl_super with + | None -> die "" __LOC__ + | Some (csup,_) -> loop csup + in + loop c + | _ -> die "" __LOC__)) + in + ctx.macro_depth <- ctx.macro_depth - 1; + ctx.with_type_stack <- List.tl ctx.with_type_stack; + let old = ctx.on_error in + ctx.on_error <- (fun ctx msg ep -> + (* display additional info in the case the error is not part of our original call *) + if ep.pfile <> p.pfile || ep.pmax < p.pmin || ep.pmin > p.pmax then begin + locate_macro_error := false; + old ctx msg ep; + locate_macro_error := true; + ctx.com.error (compl_msg "Called from macro here") p; + end else + old ctx msg ep; + ); + let e = try + f() + with exc -> + ctx.on_error <- old; + !ethis_f(); + raise exc + in + let e = Diagnostics.secure_generated_code ctx e in + ctx.on_error <- old; + !ethis_f(); + e + + (* Calls `e` with arguments `el`. Does not inspect the callee expression, so it should only be + used with actual expression calls and not with something like field calls. *) + method expr_call (e : texpr) (el : expr list) = + check_assign(); + let rec loop t = match follow t with + | TFun (args,r) -> + let el, tfunc = unify_call_args ctx el args r p false false false in + let r = match tfunc with TFun(_,r) -> r | _ -> die "" __LOC__ in + mk (TCall (e,el)) r p + | TAbstract(a,tl) when Meta.has Meta.Callable a.a_meta -> + loop (Abstract.get_underlying_type a tl) + | TMono _ -> + let t = mk_mono() in + let el = List.map (fun e -> type_expr ctx e WithType.value) el in + unify ctx (tfun (List.map (fun e -> e.etype) el) t) e.etype e.epos; + mk (TCall (e,el)) t p + | t -> + let el = List.map (fun e -> type_expr ctx e WithType.value) el in + let t = if t == t_dynamic then + t_dynamic + else if ctx.untyped then + mk_mono() + else + error (s_type (print_context()) e.etype ^ " cannot be called") e.epos + in + mk (TCall (e,el)) t p + in + loop e.etype + + (* Calls the resolve method represented by `sea` with an additional string-expression argument `name`. *) + method resolve_call (sea : static_extension_access) (name : string) = + let eparam = sea.se_this in + let e_name = Texpr.Builder.make_string ctx.t name null_pos in + self#field_call sea.se_access [eparam;e_name] [] + + (* Resolves the accessor function for `fa` and calls it with the provided arguments. + If no accessor function is found (AccessorAnon case), a generic field access is generated instead. + *) + method accessor_call fa el_typed el = + match FieldAccess.resolve_accessor fa mode with + | AccessorFound fa_accessor -> + let dispatcher = new call_dispatcher ctx (MCall el) with_type p in + let e = dispatcher#field_call fa_accessor el_typed el in + let t = FieldAccess.get_map_function fa fa.fa_field.cf_type in + if not (type_iseq_strict t e.etype) then mk (TCast(e,None)) t e.epos else e + | AccessorAnon -> + let e = fa.fa_on in + let t = FieldAccess.get_map_function fa fa.fa_field.cf_type in + let el = List.map (fun e -> type_expr ctx e WithType.value) el in + let el_typed = el_typed @ el in + let tf = tfun (List.map (fun e -> e.etype) el_typed) t in + let name = Printf.sprintf "%s_%s" (if is_set then "set" else "get") fa.fa_field.cf_name in + make_call ctx (mk (TField (e,quick_field_dynamic e.etype name)) tf p) el_typed t p + | _ -> + error "Could not resolve accessor" p + + (* Calls the field represented by `fa` with the typed arguments `el_typed` and the syntactic arguments `el`. + + This function inspects the nature of the field being called and dispatches the call accordingly: + + * If the field is `@:generic`, call `type_generic_function`. + * If the field is a non-macro method, call it via `make_field_call`. + * If the field is a property, resolve the accessor (depending on `mode`) and recurse onto it. + * Otherwise, call the field as a normal expression via `expr_call`. + *) + method field_call (fa : field_access) (el_typed : texpr list) (el : expr list) = + match fa.fa_field.cf_kind with + | Method (MethNormal | MethInline | MethDynamic) -> + check_assign(); + if has_class_field_flag fa.fa_field CfGeneric then begin + !type_generic_function_ref ctx fa el_typed el with_type p + end else + self#make_field_call fa el_typed el + | Method MethMacro -> + begin match el_typed with + | [] -> + self#macro_call fa.fa_on fa.fa_field el + | el_typed -> + let cur = ctx.this_stack in + let el' = List.map (fun e -> fst (push_this ctx e)) el_typed in + let e = self#macro_call fa.fa_on fa.fa_field (el' @ el) in + ctx.this_stack <- cur; + e + end; + | Var v -> + begin match (if is_set then v.v_write else v.v_read) with + | AccCall -> + self#accessor_call fa el_typed el + | _ -> + self#expr_call (FieldAccess.get_field_expr fa FCall) el + end +end + +let maybe_reapply_overload_call ctx e = + match e.eexpr with + | TCall({eexpr = TField(e1,fa)} as ef,el) -> + let recall fh cf = + let fa = FieldAccess.create e1 cf fh false ef.epos in + let fcc = unify_field_call ctx fa el [] e.epos false in + let e1 = fcc.fc_data() in + (try Type.unify e1.etype e.etype + with Unify_error _ -> die ~p:e.epos "Failed to reapply overload call" __LOC__); + e1 + in + begin match fa with + | FStatic(c,cf) when has_class_field_flag cf CfOverload -> + recall (FHStatic c) cf + | FInstance(c,tl,cf) when has_class_field_flag cf CfOverload -> + recall (FHInstance(c,tl)) cf + | _ -> + e + end + | _ -> + e \ No newline at end of file diff --git a/src/typing/calls.ml b/src/typing/calls.ml index 95ec7c54..85594149 100644 --- a/src/typing/calls.ml +++ b/src/typing/calls.ml @@ -7,13 +7,7 @@ open Typecore open TyperBase open Fields open Error - -let is_forced_inline c cf = - match c with - | Some { cl_extern = true } -> true - | Some { cl_kind = KAbstractImpl _ } -> true - | _ when has_class_field_flag cf CfExtern -> true - | _ -> false +open CallUnification let make_call ctx e params t ?(force_inline=false) p = try @@ -29,7 +23,8 @@ let make_call ctx e params t ?(force_inline=false) p = raise Exit in if not force_inline then begin - if f.cf_kind <> Method MethInline then raise Exit; + let is_extern_class = match cl with Some c -> (has_class_flag c CExtern) | _ -> false in + if not (Inline.needs_inline ctx is_extern_class f) then raise Exit; end else begin match cl with | None -> @@ -38,7 +33,7 @@ let make_call ctx e params t ?(force_inline=false) p = (* Delay this to filters because that's when cl_descendants is set. *) ctx.com.callbacks#add_before_save (fun () -> let rec has_override c = - List.exists (fun cf -> cf.cf_name = f.cf_name) c.cl_overrides + PMap.mem f.cf_name c.cl_fields || List.exists has_override c.cl_descendants in if List.exists has_override c.cl_descendants then error (Printf.sprintf "Cannot force inline-call to %s because it is overridden" f.cf_name) p @@ -81,10 +76,10 @@ let make_call ctx e params t ?(force_inline=false) p = mk (TCall (e,params)) t p let mk_array_get_call ctx (cf,tf,r,e1,e2o) c ebase p = match cf.cf_expr with - | None -> + | None when not (has_class_field_flag cf CfExtern) -> if not (Meta.has Meta.NoExpr cf.cf_meta) then display_error ctx "Recursive array get method" p; mk (TArray(ebase,e1)) r p - | Some _ -> + | _ -> let et = type_module_type ctx (TClassDecl c) None p in let ef = mk (TField(et,(FStatic(c,cf)))) tf p in make_call ctx ef [ebase;e1] r p @@ -92,456 +87,44 @@ let mk_array_get_call ctx (cf,tf,r,e1,e2o) c ebase p = match cf.cf_expr with let mk_array_set_call ctx (cf,tf,r,e1,e2o) c ebase p = let evalue = match e2o with None -> die "" __LOC__ | Some e -> e in match cf.cf_expr with - | None -> + | None when not (has_class_field_flag cf CfExtern) -> if not (Meta.has Meta.NoExpr cf.cf_meta) then display_error ctx "Recursive array set method" p; let ea = mk (TArray(ebase,e1)) r p in mk (TBinop(OpAssign,ea,evalue)) r p - | Some _ -> + | _ -> let et = type_module_type ctx (TClassDecl c) None p in let ef = mk (TField(et,(FStatic(c,cf)))) tf p in make_call ctx ef [ebase;e1;evalue] r p -let rec needs_temp_var e = - match e.eexpr with - | TLocal _ | TTypeExpr _ | TConst _ -> false - | TField (e, _) | TParenthesis e -> needs_temp_var e - | _ -> true - -let call_to_string ctx ?(resume=false) e = - let gen_to_string e = - (* Ignore visibility of the toString field. *) - ctx.meta <- (Meta.PrivateAccess,[],e.epos) :: ctx.meta; - let acc = type_field (TypeFieldConfig.create resume) ctx e "toString" e.epos MCall in - ctx.meta <- List.tl ctx.meta; - !build_call_ref ctx acc [] (WithType.with_type ctx.t.tstring) e.epos - in - if ctx.com.config.pf_static && not (is_nullable e.etype) then - gen_to_string e - else begin (* generate `if(e == null) 'null' else e.toString()` *) - let string_null = mk (TConst (TString "null")) ctx.t.tstring e.epos in - if needs_temp_var e then - let tmp = alloc_var VGenerated "tmp" e.etype e.epos in - let tmp_local = mk (TLocal tmp) tmp.v_type tmp.v_pos in - let check_null = mk (TBinop (OpEq, tmp_local, mk (TConst TNull) tmp.v_type tmp.v_pos)) ctx.t.tbool e.epos in - { - eexpr = TBlock([ - mk (TVar (tmp, Some e)) tmp.v_type tmp.v_pos; - mk (TIf (check_null, string_null, Some (gen_to_string tmp_local))) ctx.t.tstring tmp.v_pos; - - ]); - etype = ctx.t.tstring; - epos = e.epos; - } - else - let check_null = mk (TBinop (OpEq, e, mk (TConst TNull) e.etype e.epos)) ctx.t.tbool e.epos in - mk (TIf (check_null, string_null, Some (gen_to_string e))) ctx.t.tstring e.epos - end - -let rec unify_call_args' ctx el args r callp inline force_inline = - let in_call_args = ctx.in_call_args in - ctx.in_call_args <- true; - let call_error err p = - raise (Error (Call_error err,p)) - in - let arg_error ul name opt p = - let err = Stack (ul,Custom ("For " ^ (if opt then "optional " else "") ^ "function argument '" ^ name ^ "'")) in - call_error (Could_not_unify err) p - in - let mk_pos_infos t = - let infos = mk_infos ctx callp [] in - type_expr ctx infos (WithType.with_type t) - in - let rec default_value name t = - if is_pos_infos t then - mk_pos_infos t - else - null (ctx.t.tnull t) callp - in - let skipped = ref [] in - let invalid_skips = ref [] in - let skip name ul t p = - if not ctx.com.config.pf_can_skip_non_nullable_argument && not (is_nullable t) then - invalid_skips := name :: !invalid_skips; - skipped := (name,ul,p) :: !skipped; - default_value name t - in - (* let force_inline, is_extern = match cf with Some(TInst(c,_),f) -> is_forced_inline (Some c) f, c.cl_extern | _ -> false, false in *) - let type_against name t e = - try - let e = type_expr ctx e (WithType.with_argument t name) in - AbstractCast.cast_or_unify_raise ctx t e e.epos - with Error(l,p) when (match l with Call_error _ | Module_not_found _ -> false | _ -> true) -> - raise (WithTypeError (l,p)) - in - let rec loop el args = match el,args with - | [],[] -> - begin match List.rev !invalid_skips with - | [] -> () - | name :: _ -> call_error (Cannot_skip_non_nullable name) callp; - end; - [] - | _,[name,false,t] when (match follow t with TAbstract({a_path = ["haxe";"extern"],"Rest"},_) -> true | _ -> false) -> - begin match follow t with - | TAbstract({a_path=(["haxe";"extern"],"Rest")},[t]) -> - (try List.map (fun e -> type_against name t e,false) el with WithTypeError(ul,p) -> arg_error ul name false p) - | _ -> - die "" __LOC__ - end - | [],(_,false,_) :: _ -> - call_error (Not_enough_arguments args) callp - | [],(name,true,t) :: args -> - begin match loop [] args with - | [] when not (inline && (ctx.g.doinline || force_inline)) && not ctx.com.config.pf_pad_nulls -> - if is_pos_infos t then [mk_pos_infos t,true] - else [] - | args -> - let e_def = default_value name t in - (e_def,true) :: args - end - | (e,p) :: el, [] -> - begin match List.rev !skipped with - | [] -> - if ctx.is_display_file && not (Diagnostics.is_diagnostics_run p) then begin - let e = type_expr ctx (e,p) WithType.value in - (e,false) :: loop el [] - end else call_error Too_many_arguments p - | (s,ul,p) :: _ -> arg_error ul s true p - end - | e :: el,(name,opt,t) :: args -> - begin try - let e = type_against name t e in - (e,opt) :: loop el args - with - WithTypeError (ul,p)-> - if opt && List.length el < List.length args then - let e_def = skip name ul t p in - (e_def,true) :: loop (e :: el) args - else - match List.rev !skipped with - | [] -> arg_error ul name opt p - | (s,ul,p) :: _ -> arg_error ul s true p - end - in - let el = try loop el args with exc -> ctx.in_call_args <- in_call_args; raise exc; in - ctx.in_call_args <- in_call_args; - el,TFun(args,r) - -let unify_call_args ctx el args r p inline force_inline = - let el,tf = unify_call_args' ctx el args r p inline force_inline in - List.map fst el,tf - -let unify_field_call ctx fa el args ret p inline = - let map_cf cf0 map cf = - let t = map (monomorphs cf.cf_params cf.cf_type) in - begin match cf.cf_expr,cf.cf_kind with - | None,Method MethInline when not ctx.com.config.pf_overload -> - (* This is really awkward and shouldn't be here. We'll keep it for - 3.2 in order to not break code that relied on the quirky behavior - in 3.1.3, but it should really be reviewed afterwards. - Related issue: https://github.com/HaxeFoundation/haxe/issues/3846 - *) - cf.cf_expr <- cf0.cf_expr; - cf.cf_kind <- cf0.cf_kind; - | _ -> - () - end; - t,cf - in - let expand_overloads map cf = - (TFun(args,ret),cf) :: (List.map (map_cf cf map) cf.cf_overloads) - in - let candidates,co,cf,mk_fa = match fa with - | FStatic(c,cf) -> - expand_overloads (fun t -> t) cf,Some c,cf,(fun cf -> FStatic(c,cf)) - | FAnon cf -> - expand_overloads (fun t -> t) cf,None,cf,(fun cf -> FAnon cf) - | FInstance(c,tl,cf) -> - let map = apply_params c.cl_params tl in - let cfl = if cf.cf_name = "new" || not (Meta.has Meta.Overload cf.cf_meta && ctx.com.config.pf_overload) then - List.map (map_cf cf map) cf.cf_overloads - else - List.map (fun (t,cf) -> map (monomorphs cf.cf_params t),cf) (Overloads.get_overloads c cf.cf_name) - in - (TFun(args,ret),cf) :: cfl,Some c,cf,(fun cf -> FInstance(c,tl,cf)) - | FClosure(co,cf) -> - let c = match co with None -> None | Some (c,_) -> Some c in - expand_overloads (fun t -> t) cf,c,cf,(fun cf -> match co with None -> FAnon cf | Some (c,tl) -> FInstance(c,tl,cf)) - | _ -> - error "Invalid field call" p - in - let is_forced_inline = is_forced_inline co cf in - let is_overload = Meta.has Meta.Overload cf.cf_meta in - let attempt_call t cf = match follow t with - | TFun(args,ret) -> - let el,tf = unify_call_args' ctx el args ret p inline is_forced_inline in - let mk_call ethis p_field inline = - let ef = mk (TField(ethis,mk_fa cf)) t p_field in - make_call ctx ef (List.map fst el) ret ~force_inline:inline p - in - el,tf,mk_call - | _ -> - die "" __LOC__ - in - let maybe_raise_unknown_ident cerr p = - let rec loop err = - match err with - | Unknown_ident _ -> error (error_msg err) p - | Stack (e1,e2) -> (loop e1; loop e2) - | _ -> () - in - match cerr with Could_not_unify err -> loop err | _ -> () - in - let rec loop candidates = match candidates with - | [] -> [],[] - | (t,cf) :: candidates -> - begin try - let candidate = attempt_call t cf in - if ctx.com.config.pf_overload && is_overload then begin - let candidates,failures = loop candidates in - candidate :: candidates,failures - end else - [candidate],[] - with Error ((Call_error cerr as err),p) -> - maybe_raise_unknown_ident cerr p; - let candidates,failures = loop candidates in - candidates,(cf,err,p) :: failures - end - in - let fail_fun () = - let tf = TFun(args,ret) in - [],tf,(fun ethis p_field _ -> - let e1 = mk (TField(ethis,mk_fa cf)) tf p_field in - mk (TCall(e1,[])) ret p) - in - match candidates with - | [t,cf] -> - begin try - let el,tf,mk_call = attempt_call t cf in - List.map fst el,tf,mk_call - with Error _ when ctx.com.display.dms_error_policy = EPIgnore -> - fail_fun(); - end - | _ -> - let candidates,failures = loop candidates in - let fail () = - let failures = List.map (fun (cf,err,p) -> cf,error_msg err,p) failures in - let failures = remove_duplicates (fun (_,msg1,_) (_,msg2,_) -> msg1 <> msg2) failures in - begin match failures with - | [_,msg,p] -> - error msg p - | _ -> - display_error ctx "Could not find a suitable overload, reasons follow" p; - List.iter (fun (cf,msg,p2) -> - display_error ctx ("Overload resolution failed for " ^ (s_type (print_context()) cf.cf_type)) p; - display_error ctx msg p2; - ) failures; - error "End of overload failure reasons" p - end - in - if is_overload && ctx.com.config.pf_overload then begin match Overloads.Resolution.reduce_compatible candidates with - | [] -> fail() - | [el,tf,mk_call] -> List.map fst el,tf,mk_call - | _ -> error "Ambiguous overload" p - end else begin match List.rev candidates with - | [] -> fail() - | (el,tf,mk_call) :: _ -> List.map fst el,tf,mk_call - end - -let type_generic_function ctx (e,fa) el ?(using_param=None) with_type p = - let c,tl,cf,stat = match fa with - | FInstance(c,tl,cf) -> c,tl,cf,false - | FStatic(c,cf) -> c,[],cf,true - | _ -> die "" __LOC__ - in - if cf.cf_params = [] then error "Function has no type parameters and cannot be generic" p; - let monos = List.map (fun _ -> mk_mono()) cf.cf_params in - let map_monos t = apply_params cf.cf_params monos t in - let map t = if stat then map_monos t else apply_params c.cl_params tl (map_monos t) in - let t = map cf.cf_type in - let args,ret = match t,using_param with - | TFun((_,_,ta) :: args,ret),Some e -> - let ta = if not (Meta.has Meta.Impl cf.cf_meta) then ta - else match follow ta with TAbstract(a,tl) -> Abstract.get_underlying_type a tl | _ -> die "" __LOC__ - in - (* manually unify first argument *) - unify ctx e.etype ta p; - args,ret - | TFun(args,ret),None -> args,ret - | _ -> error "Invalid field type for generic call" p - in - begin match with_type with - | WithType.WithType(t,_) -> unify ctx ret t p - | _ -> () - end; - let el,_ = unify_call_args ctx el args ret p false false in - begin try - check_constraints ctx cf.cf_name cf.cf_params monos map false p - with Unify_error l -> - display_error ctx (error_msg (Unify l)) p - end; - let el = match using_param with None -> el | Some e -> e :: el in - (try - let gctx = Generic.make_generic ctx cf.cf_params monos p in - let name = cf.cf_name ^ "_" ^ gctx.Generic.name in - let unify_existing_field tcf pcf = try - unify_raise ctx tcf t p - with Error(Unify _,_) as err -> - display_error ctx ("Cannot create field " ^ name ^ " due to type mismatch") p; - display_error ctx "Conflicting field was defined here" pcf; - raise err - in - let c, cf2 = try - let cf2 = if stat then - let cf2 = PMap.find name c.cl_statics in - unify_existing_field cf2.cf_type cf2.cf_pos; - cf2 - else - let cf2 = PMap.find name c.cl_fields in - unify_existing_field cf2.cf_type cf2.cf_pos; - cf2 - in - c, cf2 - (* - java.Lib.array() relies on the ability to shadow @:generic function for certain types - see https://github.com/HaxeFoundation/haxe/issues/8393#issuecomment-508685760 - *) - (* if cf.cf_name_pos = cf2.cf_name_pos then - cf2 - else - error ("Cannot specialize @:generic because the generated function name is already used: " ^ name) p *) - with Not_found -> - let finalize_field c cf2 = - ignore(follow cf.cf_type); - let rec check e = match e.eexpr with - | TNew({cl_kind = KTypeParameter _} as c,_,_) when not (TypeloadCheck.is_generic_parameter ctx c) -> - display_error ctx "Only generic type parameters can be constructed" e.epos; - display_error ctx "While specializing this call" p; - | _ -> - Type.iter check e - in - cf2.cf_expr <- (match cf.cf_expr with - | None -> - display_error ctx "Recursive @:generic function" p; None; - | Some e -> - let e = Generic.generic_substitute_expr gctx e in - check e; - Some e - ); - cf2.cf_kind <- cf.cf_kind; - if not (has_class_field_flag cf CfPublic) then remove_class_field_flag cf2 CfPublic; - let metadata = List.filter (fun (m,_,_) -> match m with - | Meta.Generic -> false - | _ -> true - ) cf.cf_meta in - cf2.cf_meta <- (Meta.NoCompletion,[],p) :: (Meta.NoUsing,[],p) :: (Meta.GenericInstance,[],p) :: metadata - in - let mk_cf2 name = - mk_field ~static:stat name (map_monos cf.cf_type) cf.cf_pos cf.cf_name_pos - in - if stat then begin - if Meta.has Meta.GenericClassPerMethod c.cl_meta then begin - let c = Generic.static_method_container gctx c cf p in - try - let cf2 = PMap.find cf.cf_name c.cl_statics in - unify_existing_field cf2.cf_type cf2.cf_pos; - c, cf2 - with Not_found -> - let cf2 = mk_cf2 cf.cf_name in - c.cl_statics <- PMap.add cf2.cf_name cf2 c.cl_statics; - c.cl_ordered_statics <- cf2 :: c.cl_ordered_statics; - finalize_field c cf2; - c, cf2 - end else begin - let cf2 = mk_cf2 name in - c.cl_statics <- PMap.add cf2.cf_name cf2 c.cl_statics; - c.cl_ordered_statics <- cf2 :: c.cl_ordered_statics; - finalize_field c cf2; - c, cf2 - end - end else begin - let cf2 = mk_cf2 name in - if List.memq cf c.cl_overrides then c.cl_overrides <- cf2 :: c.cl_overrides; - c.cl_fields <- PMap.add cf2.cf_name cf2 c.cl_fields; - c.cl_ordered_fields <- cf2 :: c.cl_ordered_fields; - finalize_field c cf2; - c, cf2 - end - in - let e = match c.cl_kind with - | KAbstractImpl(a) -> - type_type ctx a.a_path p - | _ when stat -> - Builder.make_typeexpr (TClassDecl c) e.epos - | _ -> e - in - let fa = if stat then FStatic (c,cf2) else FInstance (c,tl,cf2) in - let e = mk (TField(e,fa)) cf2.cf_type p in - make_call ctx e el ret p - with Generic.Generic_Exception (msg,p) -> - error msg p) +let abstract_using_param_type sea = match follow sea.se_this.etype with + | TAbstract(a,tl) when has_class_field_flag sea.se_access.fa_field CfImpl -> apply_params a.a_params tl a.a_this + | _ -> sea.se_this.etype let rec acc_get ctx g p = - match g with - | AKNo f -> error ("Field " ^ f ^ " cannot be accessed for reading") p - | AKExpr e -> e - | AKSet _ | AKAccess _ | AKFieldSet _ -> die "" __LOC__ - | AKUsing (et,c,cf,e,_) when ctx.in_display -> - (* Generate a TField node so we can easily match it for position/usage completion (issue #1968) *) - let ec = type_module_type ctx (TClassDecl c) None p in - let ec = {ec with eexpr = (TMeta((Meta.StaticExtension,[],null_pos),ec))} in - let t = match follow et.etype with - | TFun (_ :: args,ret) -> TFun(args,ret) - | _ -> et.etype - in - mk (TField(ec,FStatic(c,cf))) t et.epos - | AKUsing (et,_,cf,e,_) -> - (* build a closure with first parameter applied *) - (match follow et.etype with - | TFun (_ :: args,ret) -> - let tcallb = TFun (args,ret) in - let twrap = TFun ([("_e",false,e.etype)],tcallb) in - (* arguments might not have names in case of variable fields of function types, so we generate one (issue #2495) *) - let args = List.map (fun (n,o,t) -> - let t = if o then ctx.t.tnull t else t in - o,if n = "" then gen_local ctx t e.epos else alloc_var VGenerated n t e.epos (* TODO: var pos *) - ) args in - let ve = alloc_var VGenerated "_e" e.etype e.epos in - let ecall = make_call ctx et (List.map (fun v -> mk (TLocal v) v.v_type p) (ve :: List.map snd args)) ret p in - let ecallb = mk (TFunction { - tf_args = List.map (fun (o,v) -> v,if o then Some (Texpr.Builder.make_null v.v_type v.v_pos) else None) args; - tf_type = ret; - tf_expr = (match follow ret with | TAbstract ({a_path = [],"Void"},_) -> ecall | _ -> mk (TReturn (Some ecall)) t_dynamic p); - }) tcallb p in - let ewrap = mk (TFunction { - tf_args = [ve,None]; - tf_type = tcallb; - tf_expr = mk (TReturn (Some ecallb)) t_dynamic p; - }) twrap p in - make_call ctx ewrap [e] tcallb p - | _ -> die "" __LOC__) - | AKInline (e,f,fmode,t) -> + let inline_read fa = + let cf = fa.fa_field in (* do not create a closure for static calls *) - let cmode,apply_params = match fmode with - | FStatic(c,_) -> - let f = match c.cl_kind with - | KAbstractImpl a when Meta.has Meta.Enum a.a_meta -> - (* Enum abstracts have to apply their type parameters because they are basically statics with type params (#8700). *) - let monos = List.map (fun _ -> mk_mono()) a.a_params in - apply_params a.a_params monos; - | _ -> (fun t -> t) - in - fmode,f - | FInstance (c,tl,f) -> - (FClosure (Some (c,tl),f),(fun t -> t)) + let apply_params = match fa.fa_host with + | FHStatic c -> + (fun t -> t) + | FHInstance(c,tl) -> + (fun t -> t) + | FHAbstract(a,tl,c) -> + if a.a_enum then begin + (* Enum abstracts have to apply their type parameters because they are basically statics with type params (#8700). *) + let monos = Monomorph.spawn_constrained_monos (fun t -> t) a.a_params in + apply_params a.a_params monos; + end else + (fun t -> t) | _ -> die "" __LOC__ in - ignore(follow f.cf_type); (* force computing *) - begin match f.cf_kind,f.cf_expr with + ignore(follow cf.cf_type); (* force computing *) + begin match cf.cf_kind,cf.cf_expr with | _ when not (ctx.com.display.dms_inline) -> - mk (TField (e,cmode)) t p + FieldAccess.get_field_expr fa FRead | Method _,_-> - let chk_class c = (c.cl_extern || has_class_field_flag f CfExtern) && not (Meta.has Meta.Runtime f.cf_meta) in + let chk_class c = ((has_class_flag c CExtern) || has_class_field_flag cf CfExtern) && not (Meta.has Meta.Runtime cf.cf_meta) in let wrap_extern c = let c2 = let m = c.cl_module in @@ -559,24 +142,24 @@ let rec acc_get ctx g p = c2 in let cf = try - PMap.find f.cf_name c2.cl_statics + PMap.find cf.cf_name c2.cl_statics with Not_found -> - let cf = {f with cf_kind = Method MethNormal} in + let cf = {cf with cf_kind = Method MethNormal} in c2.cl_statics <- PMap.add cf.cf_name cf c2.cl_statics; c2.cl_ordered_statics <- cf :: c2.cl_ordered_statics; cf in let e_t = type_module_type ctx (TClassDecl c2) None p in - mk (TField(e_t,FStatic(c2,cf))) t p + FieldAccess.get_field_expr (FieldAccess.create e_t cf (FHStatic c2) true p) FRead in - let e_def = mk (TField (e,cmode)) t p in - begin match follow e.etype with + let e_def = FieldAccess.get_field_expr fa FRead in + begin match follow fa.fa_on.etype with | TInst (c,_) when chk_class c -> display_error ctx "Can't create closure on an extern inline member method" p; e_def | TAnon a -> begin match !(a.a_status) with - | Statics {cl_extern = false} when has_class_field_flag f CfExtern -> + | Statics c when has_class_field_flag cf CfExtern -> display_error ctx "Cannot create closure on @:extern inline method" p; e_def | Statics c when chk_class c -> wrap_extern c @@ -587,169 +170,138 @@ let rec acc_get ctx g p = | Var _,Some e -> let rec loop e = Type.map_expr loop { e with epos = p; etype = apply_params e.etype } in let e = loop e in - let e = Inline.inline_metadata e f.cf_meta in - let tf = apply_params f.cf_type in + let e = Inline.inline_metadata e cf.cf_meta in + let tf = apply_params cf.cf_type in if not (type_iseq tf e.etype) then mk (TCast(e,None)) tf e.epos else e | Var _,None when ctx.com.display.dms_display -> - mk (TField (e,cmode)) t p + FieldAccess.get_field_expr fa FRead | Var _,None -> error "Recursive inline is not supported" p end - | AKMacro(e,cf) -> - (* If we are in display mode, we're probably hovering a macro call subject. Just generate a normal field. *) - if ctx.in_display then begin match e.eexpr with - | TTypeExpr (TClassDecl c) -> - mk (TField(e,FStatic(c,cf))) cf.cf_type e.epos - | _ -> - error "Invalid macro access" p - end else - error "Invalid macro access" p - -let rec build_call ?(mode=MGet) ctx acc el (with_type:WithType.t) p = - let check_assign () = if mode = MSet then invalid_assign p in - match acc with - | AKInline (ethis,f,fmode,t) when Meta.has Meta.Generic f.cf_meta -> - check_assign(); - type_generic_function ctx (ethis,fmode) el with_type p - | AKInline (ethis,f,fmode,t) -> - check_assign(); - (match follow t with - | TFun (args,r) -> - let _,_,mk_call = unify_field_call ctx fmode el args r p true in - mk_call ethis p true - | _ -> - error (s_type (print_context()) t ^ " cannot be called") p - ) - | AKUsing (et,cl,ef,eparam,forced_inline (* TOOD? *)) when Meta.has Meta.Generic ef.cf_meta -> - check_assign(); - (match et.eexpr with - | TField(ec,fa) -> - type_generic_function ctx (ec,fa) el ~using_param:(Some eparam) with_type p - | _ -> die "" __LOC__) - | AKUsing (et,cl,ef,eparam,force_inline) -> - begin match ef.cf_kind with + in + let dispatcher () = new call_dispatcher ctx MGet WithType.value p in + match g with + | AKNo f -> error ("Field " ^ f ^ " cannot be accessed for reading") p + | AKExpr e -> e + | AKAccess _ -> die "" __LOC__ + | AKResolve(sea,name) -> + (dispatcher ())#resolve_call sea name + | AKUsingAccessor sea | AKUsingField sea when ctx.in_display -> + (* Generate a TField node so we can easily match it for position/usage completion (issue #1968) *) + let e_field = FieldAccess.get_field_expr sea.se_access FGet in + (* TODO *) + (* let ec = {ec with eexpr = (TMeta((Meta.StaticExtension,[],null_pos),ec))} in *) + let t = match follow e_field.etype with + | TFun (_ :: args,ret) -> TFun(args,ret) + | t -> t + in + {e_field with etype = t} + | AKField fa -> + begin match fa.fa_field.cf_kind with | Method MethMacro -> - let ethis = type_module_type ctx (TClassDecl cl) None p in - let eparam,f = push_this ctx eparam in - let e = build_call ~mode ctx (AKMacro (ethis,ef)) (eparam :: el) with_type p in - f(); - e + (* If we are in display mode, we're probably hovering a macro call subject. Just generate a normal field. *) + if ctx.in_display then + FieldAccess.get_field_expr fa FRead + else + error "Invalid macro access" p | _ -> - check_assign(); - let t = follow (field_type ctx cl [] ef p) in - (* for abstracts we have to apply their parameters to the static function *) - let t,tthis = match follow eparam.etype with - | TAbstract(a,tl) when Meta.has Meta.Impl ef.cf_meta -> apply_params a.a_params tl t,apply_params a.a_params tl a.a_this - | te -> t,te - in - let params,args,r,eparam = match t with - | TFun ((_,_,t1) :: args,r) -> - unify ctx tthis t1 eparam.epos; - let ef = prepare_using_field ef in - begin match unify_call_args ctx el args r p (ef.cf_kind = Method MethInline) (is_forced_inline (Some cl) ef) with - | el,TFun(args,r) -> el,args,r,eparam - | _ -> die "" __LOC__ - end - | _ -> die "" __LOC__ - in - make_call ctx ~force_inline et (eparam :: params) r p + if fa.fa_inline then + inline_read fa + else + FieldAccess.get_field_expr fa FRead end - | AKMacro (ethis,cf) -> - if ctx.macro_depth > 300 then error "Stack overflow" p; - ctx.macro_depth <- ctx.macro_depth + 1; - ctx.with_type_stack <- with_type :: ctx.with_type_stack; - let ethis_f = ref (fun () -> ()) in - let f = (match ethis.eexpr with - | TTypeExpr (TClassDecl c) -> - (match ctx.g.do_macro ctx MExpr c.cl_path cf.cf_name el p with - | None -> (fun() -> type_expr ~mode ctx (EConst (Ident "null"),p) WithType.value) - | Some (EMeta((Meta.MergeBlock,_,_),(EBlock el,_)),_) -> (fun () -> let e = (!type_block_ref) ctx el with_type p in mk (TMeta((Meta.MergeBlock,[],p), e)) e.etype e.epos) - | Some e -> (fun() -> type_expr ~mode ctx e with_type)) - | _ -> - (* member-macro call : since we will make a static call, let's find the actual class and not its subclass *) - (match follow ethis.etype with - | TInst (c,_) -> - let rec loop c = - if PMap.mem cf.cf_name c.cl_fields then - let eparam,f = push_this ctx ethis in - ethis_f := f; - let e = match ctx.g.do_macro ctx MExpr c.cl_path cf.cf_name (eparam :: el) p with - | None -> (fun() -> type_expr ~mode ctx (EConst (Ident "null"),p) WithType.value) - | Some e -> (fun() -> type_expr ~mode ctx e WithType.value) - in - e - else - match c.cl_super with - | None -> die "" __LOC__ - | Some (csup,_) -> loop csup - in - loop c - | _ -> die "" __LOC__)) - in - ctx.macro_depth <- ctx.macro_depth - 1; - ctx.with_type_stack <- List.tl ctx.with_type_stack; - let old = ctx.on_error in - ctx.on_error <- (fun ctx msg ep -> - (* display additional info in the case the error is not part of our original call *) - if ep.pfile <> p.pfile || ep.pmax < p.pmin || ep.pmin > p.pmax then begin - TypeloadFields.locate_macro_error := false; - old ctx msg ep; - TypeloadFields.locate_macro_error := true; - ctx.com.error "Called from macro here" p; - end else - old ctx msg ep; - ); - let e = try - f() - with exc -> - ctx.on_error <- old; - !ethis_f(); - raise exc - in - let e = Diagnostics.secure_generated_code ctx e in - ctx.on_error <- old; - !ethis_f(); - e - | AKNo _ | AKSet _ | AKAccess _ | AKFieldSet _ -> + | AKAccessor fa -> + (dispatcher())#field_call fa [] [] + | AKUsingAccessor sea -> + (dispatcher())#field_call sea.se_access [sea.se_this] [] + | AKUsingField sea -> + let e = sea.se_this in + let e_field = FieldAccess.get_field_expr sea.se_access FGet in + (* build a closure with first parameter applied *) + (match follow e_field.etype with + | TFun ((_,_,t0) :: args,ret) -> + let te = abstract_using_param_type sea in + unify ctx te t0 e.epos; + let tcallb = TFun (args,ret) in + let twrap = TFun ([("_e",false,e.etype)],tcallb) in + (* arguments might not have names in case of variable fields of function types, so we generate one (issue #2495) *) + let args = List.map (fun (n,o,t) -> + let t = if o then ctx.t.tnull t else t in + o,if n = "" then gen_local ctx t e.epos else alloc_var VGenerated n t e.epos (* TODO: var pos *) + ) args in + let ve = alloc_var VGenerated "_e" e.etype e.epos in + let ecall = make_call ctx e_field (List.map (fun v -> mk (TLocal v) v.v_type p) (ve :: List.map snd args)) ret p in + let ecallb = mk (TFunction { + tf_args = List.map (fun (o,v) -> v,if o then Some (Texpr.Builder.make_null v.v_type v.v_pos) else None) args; + tf_type = ret; + tf_expr = (match follow ret with | TAbstract ({a_path = [],"Void"},_) -> ecall | _ -> mk (TReturn (Some ecall)) t_dynamic p); + }) tcallb p in + let ewrap = mk (TFunction { + tf_args = [ve,None]; + tf_type = tcallb; + tf_expr = mk (TReturn (Some ecallb)) t_dynamic p; + }) twrap p in + make_call ctx ewrap [e] tcallb p + | _ -> die "" __LOC__) + +let build_call ?(mode=MGet) ctx acc el (with_type:WithType.t) p = + let dispatch = new call_dispatcher ctx mode with_type p in + match acc with + | AKField fa -> + dispatch#field_call fa [] el + | AKUsingField sea -> + let eparam = sea.se_this in + dispatch#field_call sea.se_access [eparam] el + | AKResolve(sea,name) -> + dispatch#expr_call (dispatch#resolve_call sea name) el + | AKNo _ | AKAccess _ -> ignore(acc_get ctx acc p); - die "" __LOC__ + error ("Unexpected access mode, please report this: " ^ (s_access_kind acc)) p + | AKAccessor fa -> + let e = dispatch#field_call fa [] [] in + dispatch#expr_call e el + | AKUsingAccessor sea -> + let e = dispatch#field_call sea.se_access [sea.se_this] [] in + dispatch#expr_call e el | AKExpr e -> - let rec loop t = match follow t with - | TFun (args,r) -> - begin match e.eexpr with - | TField(e1,fa) when not (match fa with FEnum _ | FDynamic _ -> true | _ -> false) -> - begin match fa with - | FInstance(_,_,cf) | FStatic(_,cf) when Meta.has Meta.Generic cf.cf_meta -> - type_generic_function ctx (e1,fa) el with_type p - | _ -> - let _,_,mk_call = unify_field_call ctx fa el args r p false in - mk_call e1 e.epos false - end - | _ -> - let el, tfunc = unify_call_args ctx el args r p false false in - let r = match tfunc with TFun(_,r) -> r | _ -> die "" __LOC__ in - mk (TCall (e,el)) r p - end - | TAbstract(a,tl) when Meta.has Meta.Callable a.a_meta -> - loop (Abstract.get_underlying_type a tl) - | TMono _ -> - let t = mk_mono() in - let el = List.map (fun e -> type_expr ctx e WithType.value) el in - unify ctx (tfun (List.map (fun e -> e.etype) el) t) e.etype e.epos; - mk (TCall (e,el)) t p - | t -> - let el = List.map (fun e -> type_expr ctx e WithType.value) el in - let t = if t == t_dynamic then - t_dynamic - else if ctx.untyped then - mk_mono() - else - error (s_type (print_context()) e.etype ^ " cannot be called") e.epos - in - mk (TCall (e,el)) t p - in - loop e.etype + dispatch#expr_call e el + +let rec needs_temp_var e = + match e.eexpr with + | TLocal _ | TTypeExpr _ | TConst _ -> false + | TField (e, _) | TParenthesis e -> needs_temp_var e + | _ -> true + +let call_to_string ctx ?(resume=false) e = + let gen_to_string e = + (* Ignore visibility of the toString field. *) + ctx.meta <- (Meta.PrivateAccess,[],e.epos) :: ctx.meta; + let acc = type_field (TypeFieldConfig.create resume) ctx e "toString" e.epos (MCall []) (WithType.with_type ctx.t.tstring) in + ctx.meta <- List.tl ctx.meta; + build_call ctx acc [] (WithType.with_type ctx.t.tstring) e.epos + in + if ctx.com.config.pf_static && not (is_nullable e.etype) then + gen_to_string e + else begin (* generate `if(e == null) 'null' else e.toString()` *) + let string_null = mk (TConst (TString "null")) ctx.t.tstring e.epos in + if needs_temp_var e then + let tmp = alloc_var VGenerated "tmp" e.etype e.epos in + let tmp_local = mk (TLocal tmp) tmp.v_type tmp.v_pos in + let check_null = mk (TBinop (OpEq, tmp_local, mk (TConst TNull) tmp.v_type tmp.v_pos)) ctx.t.tbool e.epos in + { + eexpr = TBlock([ + mk (TVar (tmp, Some e)) tmp.v_type tmp.v_pos; + mk (TIf (check_null, string_null, Some (gen_to_string tmp_local))) ctx.t.tstring tmp.v_pos; + + ]); + etype = ctx.t.tstring; + epos = e.epos; + } + else + let check_null = mk (TBinop (OpEq, e, mk (TConst TNull) e.etype e.epos)) ctx.t.tbool e.epos in + mk (TIf (check_null, string_null, Some (gen_to_string e))) ctx.t.tstring e.epos + end let type_bind ctx (e : texpr) (args,ret) params p = let vexpr v = mk (TLocal v) v.v_type p in @@ -828,7 +380,7 @@ let array_access ctx e1 e2 mode p = (match follow e1.etype with | TAbstract ({a_impl = Some c} as a,pl) when a.a_array <> [] -> begin match mode with - | MSet -> + | MSet _ -> (* resolve later *) AKAccess (a,pl,c,e1,e2) | _ -> @@ -854,7 +406,7 @@ let array_access ctx e1 e2 mode p = let skip_abstract = fast_eq et at in loop ~skip_abstract at | _, _ -> - let pt = mk_mono() in + let pt = spawn_monomorph ctx p in let t = ctx.t.tarray pt in begin try unify_raise ctx et t p @@ -879,8 +431,16 @@ let array_access ctx e1 e2 mode p = given chain of fields as the `path` argument and an `access_mode->access_kind` getter for some starting expression as `e`, return a new `access_mode->access_kind` getter for the whole field access chain. *) -let field_chain ctx path e = - List.fold_left (fun e (f,_,p) -> - let e = acc_get ctx (e MGet) p in - type_field_default_cfg ctx e f p - ) e path +let field_chain ctx path access mode with_type = + let rec loop access path = match path with + | [] -> + access + | [(name,_,p)] -> + let e = acc_get ctx access p in + type_field_default_cfg ctx e name p mode with_type + | (name,_,p) :: path -> + let e = acc_get ctx access p in + let access = type_field_default_cfg ctx e name p MGet WithType.value in + loop access path + in + loop access path \ No newline at end of file diff --git a/src/typing/fieldAccess.ml b/src/typing/fieldAccess.ml new file mode 100644 index 00000000..145e14bb --- /dev/null +++ b/src/typing/fieldAccess.ml @@ -0,0 +1,159 @@ +open Typecore +open Type +open Error + +type field_host = + (* Get the plain expression with applied field type parameters. *) + | FGet + (* Does not apply field type parameters. *) + | FCall + (* Actual reading, for FClosure and such. *) + | FRead + (* Used as lhs, no semantic difference to FGet. *) + | FWrite + +type accessor_resolution = + (* Accessor was found. *) + | AccessorFound of field_access + (* Accessor was not found, but access was made on anonymous structure. *) + | AccessorAnon + (* Accessor was not found. *) + | AccessorNotFound + (* Accessor resolution was attempted on a non-property. *) + | AccessorInvalid + +let create e cf fh inline p = { + fa_on = e; + fa_field = cf; + fa_host = fh; + fa_inline = inline; + fa_pos = p; +} + +(* Creates the `tfield_access` corresponding to this field access, using the provided field. *) +let apply_fa cf = function + | FHStatic c -> FStatic(c,cf) + | FHInstance(c,tl) -> FInstance(c,tl,cf) + | FHAbstract(a,tl,c) -> FStatic(c,cf) + | FHAnon -> FAnon cf + +(* Returns the mapping function to apply type parameters. *) +let get_map_function fa = match fa.fa_host with + | FHStatic _ | FHAnon -> (fun t -> t) + | FHInstance(c,tl) -> TClass.get_map_function c tl + | FHAbstract(a,tl,_) -> apply_params a.a_params tl + +(* Converts the field access to a `TField` node, using the provided `mode`. *) +let get_field_expr fa mode = + let cf = fa.fa_field in + let t = match mode with + | FCall -> cf.cf_type + | FGet | FRead | FWrite -> Type.field_type cf + in + let fa',t = match fa.fa_host with + | FHStatic c -> + FStatic(c,cf),t + | FHInstance(c,tl) -> + let fa = match cf.cf_kind with + | Method _ when mode = FRead -> + FClosure(Some(c,tl),cf) + | _ -> + FInstance(c,tl,cf) + in + let t = TClass.get_map_function c tl t in + fa,t + | FHAbstract(a,tl,c) -> + FStatic(c,cf),apply_params a.a_params tl t + | FHAnon -> + let fa = match cf.cf_kind with + | Method _ when mode = FRead -> + FClosure(None,cf) + | _ -> + FAnon cf + in + fa,t + in + mk (TField(fa.fa_on,fa')) t fa.fa_pos + +(* Resolves the accessor on the field access, using the provided `mode`. *) +let resolve_accessor fa mode = match fa.fa_field.cf_kind with + | Var v -> + begin match (match mode with MSet _ -> v.v_write | _ -> v.v_read) with + | AccCall -> + let name = (match mode with MSet _ -> "set_" | _ -> "get_") ^ fa.fa_field.cf_name in + let forward cf_acc new_host = + create fa.fa_on cf_acc new_host fa.fa_inline fa.fa_pos + in + begin match fa.fa_host with + | FHStatic c -> + begin try + AccessorFound (forward (PMap.find name c.cl_statics) fa.fa_host) + with Not_found -> + (* TODO: Check if this is correct, there's a case in hxcpp's VirtualArray *) + AccessorAnon + end + | FHInstance(c,tl) -> + begin try + (* Accessors can be overridden, so we have to check the actual type. *) + let c,tl = match follow fa.fa_on.etype with + | TInst(c,tl) -> c,tl + | _ -> c,tl + in + let (c2,_,cf_acc) = raw_class_field (fun f -> f.cf_type) c tl name in + let new_host = match c2 with + | None -> FHAnon + | Some(c,tl) -> FHInstance(c,tl) + in + AccessorFound (forward cf_acc new_host) + with Not_found -> + if has_class_flag c CExtern then AccessorAnon else AccessorNotFound + end + | FHAbstract(a,tl,c) -> + begin try + AccessorFound (forward (PMap.find name c.cl_statics) fa.fa_host) + with Not_found -> + AccessorAnon + end + | FHAnon -> + AccessorAnon + end + | _ -> + AccessorInvalid + end + | _ -> + AccessorInvalid + +let get_constructor_access c tl p = + try + let e_static = Builder.make_static_this c p in + let c, tl = match c.cl_kind with + | KAbstractImpl a -> (match Abstract.follow_with_forward_ctor (TAbstract(a,tl)) with + | TInst(c,tl) -> c, tl + | TAbstract({a_impl = Some c},tl) -> c, tl + | _ -> c, tl) + | _ -> c, tl + in + let cf, fh = match c.cl_kind with + | KAbstractImpl a -> PMap.find "_new" c.cl_statics, FHAbstract(a,tl,c) + | _ -> Type.get_constructor c, FHInstance(c,tl) + in + create e_static cf fh false p + with Not_found -> + raise_error (No_constructor (match c.cl_kind with + | KAbstractImpl a -> TAbstractDecl a + | _ -> TClassDecl c + )) p + +let make_static_extension_access c cf e_this inline p = + let e_static = Texpr.Builder.make_static_this c p in + { + se_this = e_this; + se_access = create e_static cf (FHStatic c) inline p + } + +let make_abstract_static_extension_access a tl c cf e_this inline p = + let e_static = Texpr.Builder.make_static_this c p in + { + se_this = e_this; + se_access = create e_static cf (FHAbstract(a,tl,c)) inline p + } diff --git a/src/typing/fields.ml b/src/typing/fields.ml index 83837561..49f67807 100644 --- a/src/typing/fields.ml +++ b/src/typing/fields.ml @@ -5,6 +5,7 @@ open Type open TyperBase open Error open Typecore +open FieldAccess module TypeFieldConfig = struct type t = { @@ -57,87 +58,30 @@ let remove_constant_flag t callb = restore(); raise e -let check_constraints ctx tname tpl tl map delayed p = - List.iter2 (fun m (name,t) -> - match follow t with - | TInst ({ cl_kind = KTypeParameter constr },_) when constr <> [] -> - let f = (fun() -> - List.iter (fun ct -> - try - Type.unify (map m) (map ct) - with Unify_error l -> - let l = Constraint_failure (tname ^ "." ^ name) :: l in - raise (Unify_error l) - ) constr - ) in - if delayed then - delay ctx PCheckConstraint (fun () -> try f() with Unify_error l -> display_error ctx (error_msg (Unify l)) p) - else - f() - | _ -> - () - ) tl tpl - -let enum_field_type ctx en ef tl_en tl_ef p = - let map t = apply_params en.e_params tl_en (apply_params ef.ef_params tl_ef t) in - begin try - check_constraints ctx (s_type_path en.e_path) en.e_params tl_en map true p; - check_constraints ctx ef.ef_name ef.ef_params tl_ef map true p; - with Unify_error l -> - display_error ctx (error_msg (Unify l)) p - end; +let enum_field_type ctx en ef p = + let tl_en = Monomorph.spawn_constrained_monos (fun t -> t) en.e_params in + let map = apply_params en.e_params tl_en in + let tl_ef = Monomorph.spawn_constrained_monos map ef.ef_params in + let map t = map (apply_params ef.ef_params tl_ef t) in map ef.ef_type -let add_constraint_checks ctx ctypes pl f tl p = - List.iter2 (fun m (name,t) -> - match follow t with - | TInst ({ cl_kind = KTypeParameter constr },_) when constr <> [] -> - let constr = List.map (fun t -> - let t = apply_params f.cf_params tl t in - (* only apply params if not static : in that case no param is passed *) - let t = (if pl = [] then t else apply_params ctypes pl t) in - t - ) constr in - delay ctx PCheckConstraint (fun() -> - List.iter (fun ct -> - try - (* if has_mono m then raise (Unify_error [Unify_custom "Could not resolve full type for constraint checks"; Unify_custom ("Type was " ^ (s_type (print_context()) m))]); *) - Type.unify m ct - with Unify_error l -> - display_error ctx (error_msg (Unify (Constraint_failure (f.cf_name ^ "." ^ name) :: l))) p; - ) constr - ); - | _ -> () - ) tl f.cf_params - let field_type ctx c pl f p = match f.cf_params with | [] -> f.cf_type | l -> - let monos = List.map (fun _ -> mk_mono()) l in - if not (Meta.has Meta.Generic f.cf_meta) then add_constraint_checks ctx c.cl_params pl f monos p; + let monos = Monomorph.spawn_constrained_monos (if pl = [] then (fun t -> t) else apply_params c.cl_params pl) f.cf_params in apply_params l monos f.cf_type -let fast_enum_field e ef p = - let et = mk (TTypeExpr (TEnumDecl e)) (mk_anon (ref (EnumStatics e))) p in - TField (et,FEnum (e,ef)) - -let get_constructor ctx c params p = - match c.cl_kind with - | KAbstractImpl a -> - let f = (try PMap.find "_new" c.cl_statics with Not_found -> raise_error (No_constructor (TAbstractDecl a)) p) in - let ct = field_type ctx c params f p in - apply_params a.a_params params ct, f - | _ -> - let ct, f = (try Type.get_constructor (fun f -> field_type ctx c params f p) c with Not_found -> raise_error (No_constructor (TClassDecl c)) p) in - apply_params c.cl_params params ct, f +let no_abstract_constructor c p = + if has_class_flag c CAbstract then raise_error (Abstract_class (TClassDecl c)) p let check_constructor_access ctx c f p = if (Meta.has Meta.CompilerGenerated f.cf_meta) then display_error ctx (error_msg (No_constructor (TClassDecl c))) p; if not (can_access ctx c f true || extends ctx.curclass c) && not ctx.untyped then display_error ctx (Printf.sprintf "Cannot access private constructor of %s" (s_class_path c)) p -let check_no_closure_meta ctx fa mode p = - if mode <> MCall && not (DisplayPosition.display_position#enclosed_in p) then begin +let check_no_closure_meta ctx cf fa mode p = + match mode with + | MGet | MSet _ when not (DisplayPosition.display_position#enclosed_in p) -> let check_field f cl_meta = match f.cf_kind with | Method _ -> @@ -148,95 +92,121 @@ let check_no_closure_meta ctx fa mode p = error ("Method " ^ f.cf_name ^ " cannot be used as a value") p | _ -> () in - match fa with - | FStatic (c, ({ cf_kind = Method _} as f)) -> check_field f c.cl_meta - | FInstance (c, _, ({ cf_kind = Method _} as f)) -> check_field f c.cl_meta - | FClosure (Some (c, _), ({ cf_kind = Method _} as f)) -> check_field f c.cl_meta - | FClosure (None, ({ cf_kind = Method _} as f)) -> check_field f [] - | FAnon ({ cf_kind = Method _} as f) -> check_field f [] - | _ -> () - end + begin match cf.cf_kind with + | Method _ -> + let meta = match fa with + | FHStatic c | FHInstance(c,_) | FHAbstract(_,_,c) -> c.cl_meta + | _ -> [] + in + check_field cf meta + | _ -> + () + end + | _ -> + () -let field_access ctx mode f fmode t e p = - check_no_closure_meta ctx fmode mode p; +(* Note: `p` is the position of the field access expression. *) +let field_access ctx mode f fh e pfield = + let pfull = punion e.epos pfield in + let is_set = match mode with MSet _ -> true | _ -> false in + check_no_closure_meta ctx f fh mode pfield; let bypass_accessor = if ctx.bypass_accessor > 0 then (ctx.bypass_accessor <- ctx.bypass_accessor - 1; true) else false in - let fnormal() = AKExpr (mk (TField (e,fmode)) t p) in - let normal() = - match follow e.etype with - | TAnon a -> - (match !(a.a_status) with - | EnumStatics en -> - let c = (try PMap.find f.cf_name en.e_constrs with Not_found -> die "" __LOC__) in - let fmode = FEnum (en,c) in - AKExpr (mk (TField (e,fmode)) t p) - | _ -> fnormal()) - | _ -> fnormal() - in + let make_access inline = FieldAccess.create e f fh inline pfull in match f.cf_kind with | Method m -> - if mode = MSet && m <> MethDynamic && not ctx.untyped then error "Cannot rebind this method : please use 'dynamic' before method declaration" p; - begin match ctx.curfun,e.eexpr with - | (FunMemberAbstract | FunMemberAbstractLocal),TTypeExpr(TClassDecl ({cl_kind = KAbstractImpl a} as c)) when c == ctx.curclass && Meta.has Meta.Impl f.cf_meta -> - let e = mk (TField(e,fmode)) t p in - let ethis = get_this ctx p in - let ethis = {ethis with etype = TAbstract(a,List.map snd a.a_params)} in - AKUsing(e,ctx.curclass,f,ethis,false) - | _ -> - (match m, mode with - | MethInline, _ -> AKInline (e,f,fmode,t) - | MethMacro, MGet -> display_error ctx "Macro functions must be called immediately" p; normal() - | MethMacro, MCall -> AKMacro (e,f) + let normal () = AKField(make_access false) in + if is_set && m <> MethDynamic && not ctx.untyped then error "Cannot rebind this method : please use 'dynamic' before method declaration" pfield; + let maybe_check_visibility c static = + (* For overloads we have to resolve the actual field before we can check accessibility. *) + begin match mode with + | MCall _ when has_class_field_flag f CfOverload -> + () + | _ -> + check_field_access ctx c f static pfield + end; + in + let default () = + match m, mode with + | MethInline, _ when ctx.g.doinline -> + AKField (make_access true) + | MethMacro, MGet -> + display_error ctx "Macro functions must be called immediately" pfield; normal() | _ , MGet -> - let cmode = (match fmode with - | FInstance(_, _, cf) | FStatic(_, cf) when Meta.has Meta.Generic cf.cf_meta -> display_error ctx "Cannot create closure on generic function" p; fmode - | FInstance (c,tl,cf) -> FClosure (Some (c,tl),cf) - | FStatic _ | FEnum _ -> fmode - | FAnon f -> FClosure (None, f) - | FDynamic _ | FClosure _ -> die "" __LOC__ - ) in - AKExpr (mk (TField (e,cmode)) t p) - | _ -> normal()) - end + if has_class_field_flag f CfGeneric then display_error ctx "Cannot create closure on generic function" pfield; + normal() + | _ -> + normal() + in + begin match fh with + | FHInstance(c,tl) -> + if e.eexpr = TConst TSuper then (match mode,f.cf_kind with + | MGet,Var {v_read = AccCall } + | MSet _,Var {v_write = AccCall } + | MCall _,Var {v_read = AccCall } -> + () + | MCall _, Var _ -> + display_error ctx "Cannot access superclass variable for calling: needs to be a proper method" pfield + | MCall _, _ -> + () + | MGet,Var _ + | MSet _,Var _ when ctx.com.platform = Flash && has_class_flag c CExtern -> + () + | _, Method _ -> + display_error ctx "Cannot create closure on super method" pfield + | _ -> + display_error ctx "Normal variables cannot be accessed with 'super', use 'this' instead" pfield); + (* We need the actual class type (i.e. a potential child class) for visibility checks. *) + begin match follow e.etype with + | TInst(c,_) -> + maybe_check_visibility c false; + | _ -> + () + end; + default(); + | FHStatic c -> + maybe_check_visibility c true; + default() + | FHAnon -> + default() + | FHAbstract(a,tl,c) -> + maybe_check_visibility c true; + let sea = make_abstract_static_extension_access a tl c f e false pfull in + AKUsingField sea + end; | Var v -> - match (match mode with MGet | MCall -> v.v_read | MSet -> v.v_write) with + begin match fh with + | FHStatic c | FHAbstract(_,_,c) -> + check_field_access ctx c f true pfield + | FHInstance _ -> + begin match follow e.etype with + | TInst(c,_) -> + check_field_access ctx c f false pfield + | _ -> + () + end; + | FHAnon -> + () + end; + let normal inline = + AKField (make_access inline) + in + match (match mode with MGet | MCall _ -> v.v_read | MSet _ -> v.v_write) with | AccNo when not (Meta.has Meta.PrivateAccess ctx.meta) -> (match follow e.etype with - | TInst (c,_) when extends ctx.curclass c || can_access ctx c { f with cf_flags = unset_flag f.cf_flags (int_of_class_field_flag CfPublic) } false -> normal() + | TInst (c,_) when extends ctx.curclass c || can_access ctx c { f with cf_flags = unset_flag f.cf_flags (int_of_class_field_flag CfPublic) } false -> + normal false | TAnon a -> (match !(a.a_status) with - | Opened when mode = MSet -> - f.cf_kind <- Var { v with v_write = AccNormal }; - normal() - | Statics c2 when ctx.curclass == c2 || can_access ctx c2 { f with cf_flags = unset_flag f.cf_flags (int_of_class_field_flag CfPublic) } true -> normal() - | _ -> if ctx.untyped then normal() else AKNo f.cf_name) + | Statics c2 when ctx.curclass == c2 || can_access ctx c2 { f with cf_flags = unset_flag f.cf_flags (int_of_class_field_flag CfPublic) } true -> normal false + | _ -> if ctx.untyped then normal false else AKNo f.cf_name) | _ -> - if ctx.untyped then normal() else AKNo f.cf_name) + if ctx.untyped then normal false else AKNo f.cf_name) | AccNormal | AccNo -> - (* - if we are reading from a read-only variable on an anonymous object, it might actually be a method, so make sure to create a closure - *) - let is_maybe_method() = - match v.v_write, follow t, follow e.etype with - | (AccNo | AccNever), TFun _, TAnon a -> - (match !(a.a_status) with - | Statics _ | EnumStatics _ -> false - | _ -> true) - | _ -> false - in - if mode = MGet && is_maybe_method() then - AKExpr (mk (TField (e,FClosure (None,f))) t p) - else - normal() - | AccCall | AccInline when ctx.in_display -> - normal() + normal false + | AccCall when ctx.in_display && DisplayPosition.display_position#enclosed_in pfull -> + normal false | AccCall -> - let m = (match mode with MSet -> "set_" | _ -> "get_") ^ f.cf_name in - let is_abstract_this_access () = match e.eexpr,ctx.curfun with - | TTypeExpr (TClassDecl ({cl_kind = KAbstractImpl _} as c)),(FunMemberAbstract | FunMemberAbstractLocal) when Meta.has Meta.Impl f.cf_meta -> - c == ctx.curclass - | _ -> - false - in + let m = (match mode with MSet _ -> "set_" | _ -> "get_") ^ f.cf_name in let bypass_accessor = bypass_accessor || @@ -251,379 +221,337 @@ let field_access ctx mode f fmode t e p = ) in if bypass_accessor then ( - (match e.eexpr with TLocal _ when Common.defined ctx.com Define.Haxe3Compat -> ctx.com.warning "Field set has changed here in Haxe 4: call setter explicitly to keep Haxe 3.x behaviour" p | _ -> ()); + (match e.eexpr with TLocal _ when Common.defined ctx.com Define.Haxe3Compat -> ctx.com.warning "Field set has changed here in Haxe 4: call setter explicitly to keep Haxe 3.x behaviour" pfield | _ -> ()); if not (is_physical_field f) then begin - display_error ctx "This field cannot be accessed because it is not a real variable" p; + display_error ctx "This field cannot be accessed because it is not a real variable" pfield; display_error ctx "Add @:isVar here to enable it" f.cf_pos; end; - AKExpr (mk (TField (e,fmode)) t p) - ) else if is_abstract_this_access() then begin - let this = get_this ctx p in - if mode = MSet then begin - let c,a = match ctx.curclass with {cl_kind = KAbstractImpl a} as c -> c,a | _ -> die "" __LOC__ in - let f = PMap.find m c.cl_statics in - (* we don't have access to the type parameters here, right? *) - (* let t = apply_params a.a_params pl (field_type ctx c [] f p) in *) - let t = (field_type ctx c [] f p) in - let ef = mk (TField (e,FStatic (c,f))) t p in - AKUsing (ef,c,f,this,false) - end else - AKExpr (make_call ctx (mk (TField (e,quick_field_dynamic e.etype m)) (tfun [this.etype] t) p) [this] t p) - end else if mode = MSet then - AKSet (e,t,f) - else - AKExpr (make_call ctx (mk (TField (e,quick_field_dynamic e.etype m)) (tfun [] t) p) [] t p) - | AccResolve -> - let fstring = mk (TConst (TString f.cf_name)) ctx.t.tstring p in - let tresolve = tfun [ctx.t.tstring] t in - AKExpr (make_call ctx (mk (TField (e,FDynamic "resolve")) tresolve p) [fstring] t p) + normal false + ) + else begin match fh with + | FHAbstract(a,tl,c) -> + let sea = make_abstract_static_extension_access a tl c f e false pfull in + AKUsingAccessor sea + | _ -> + AKAccessor (make_access false) + end | AccNever -> - if ctx.untyped then normal() else AKNo f.cf_name + if ctx.untyped then normal false else AKNo f.cf_name | AccInline -> - AKInline (e,f,fmode,t) + normal true | AccCtor -> - (match ctx.curfun, fmode with - | FunConstructor, FInstance(c,_,_) when c == ctx.curclass -> normal() + (match ctx.curfun, fh with + | FunConstructor, FHInstance(c,_) when c == ctx.curclass -> normal false | _ -> AKNo f.cf_name ) | AccRequire (r,msg) -> match msg with - | None -> error_require r p - | Some msg -> error msg p + | None -> error_require r pfield + | Some msg -> error msg pfield let class_field ctx c tl name p = raw_class_field (fun f -> field_type ctx c tl f p) c tl name -let rec using_field ctx mode e i p = - if mode = MSet then raise Not_found; - (* do not try to find using fields if the type is a monomorph, which could lead to side-effects *) - let is_dynamic = match follow e.etype with - | TMono _ -> raise Not_found - | t -> t == t_dynamic +(* Resolves field [i] on typed expression [e] using the given [mode]. *) +(* Note: if mode = MCall, with_type (if known) refers to the return type *) +let type_field cfg ctx e i p mode (with_type : WithType.t) = + let pfield = if e.epos = p then p else { p with pmin = p.pmax - (String.length i) } in + let is_set = match mode with MSet _ -> true | _ -> false in + let field_access e f fmode = field_access ctx mode f fmode e pfield in + let class_field_with_access e c tl = + let c2, t, f = class_field ctx c tl i p in + let fmode = match c2 with None -> FHAnon | Some (c,tl) -> FHInstance (c,tl) in + let acc = field_access e f fmode in + f, acc in - let check_constant_struct = ref false in - let rec loop = function - | [] -> - raise Not_found - | (c,pc) :: l -> - try - let cf = PMap.find i c.cl_statics in - if Meta.has Meta.NoUsing cf.cf_meta || not (can_access ctx c cf true) || (Meta.has Meta.Impl cf.cf_meta) then raise Not_found; - let monos = List.map (fun _ -> mk_mono()) cf.cf_params in - let map = apply_params cf.cf_params monos in - let t = map cf.cf_type in - begin match follow t with - | TFun((_,_,(TType({t_path = ["haxe";"macro"],"ExprOf"},[t0]) | t0)) :: args,r) -> - if is_dynamic && follow t0 != t_dynamic then raise Not_found; - let e = unify_static_extension ctx e t0 p in - (* early constraints check is possible because e.etype has no monomorphs *) - List.iter2 (fun m (name,t) -> match follow t with - | TInst ({ cl_kind = KTypeParameter constr },_) when constr <> [] && not (has_mono m) -> - List.iter (fun tc -> Type.unify m (map tc)) constr - | _ -> () - ) monos cf.cf_params; - let et = type_module_type ctx (TClassDecl c) None p in - ImportHandling.mark_import_position ctx pc; - AKUsing (mk (TField (et,FStatic (c,cf))) t p,c,cf,e,false) - | _ -> - raise Not_found - end - with Not_found -> - loop l - | Unify_error el | Error (Unify el,_) -> - if List.exists (function Has_extra_field _ -> true | _ -> false) el then check_constant_struct := true; - loop l + let find_some = function + | Some x -> x + | None -> raise Not_found in - try - (* module using from `using Path` *) - loop ctx.m.module_using - with Not_found -> try - (* type using from `@:using(Path)` *) - let mt = module_type_of_type (follow e.etype) in - loop (t_infos mt).mt_using - with Not_found | Exit -> try - (* global using *) - let acc = loop ctx.g.global_using in - (match acc with - | AKUsing (_,c,_,_,_) -> add_dependency ctx.m.curmod c.cl_module - | _ -> die "" __LOC__); - acc - with Not_found -> - if not !check_constant_struct then raise Not_found; - remove_constant_flag e.etype (fun ok -> if ok then using_field ctx mode e i p else raise Not_found) - -(* Resolves field [i] on typed expression [e] using the given [mode]. *) -let rec type_field cfg ctx e i p mode = - let pfield = if (e.epos = p) then p else {p with pmin = p.pmax - (String.length i)} in - let no_field() = - if TypeFieldConfig.do_resume cfg then raise Not_found; - let t = match follow e.etype with - | TAnon a -> (match !(a.a_status) with - | Statics {cl_kind = KAbstractImpl a} -> TAbstract(a,[]) - | _ -> e.etype) - | TInst({cl_kind = KAbstractImpl a},_) -> TAbstract(a,[]) - | _ -> e.etype - in - let has_special_field a = - List.exists (fun (_,cf) -> cf.cf_name = i) a.a_ops - || List.exists (fun (_,_,cf) -> cf.cf_name = i) a.a_unops - || List.exists (fun cf -> cf.cf_name = i) a.a_array - in - if not ctx.untyped then begin - match t with - | TAbstract(a,_) when has_special_field a -> - (* the abstract field is not part of the field list, which is only true when it has no expression (issue #2344) *) - display_error ctx ("Field " ^ i ^ " cannot be called directly because it has no expression") pfield; - | _ -> - display_error ctx (StringError.string_error i (string_source t) (s_type (print_context()) t ^ " has no field " ^ i)) pfield; - end; - AKExpr (mk (TField (e,FDynamic i)) (mk_mono()) p) + let type_field_by_et f e t = + f { e with etype = t } (follow_without_type t) in - let does_forward a stat = - try - let _,el,_ = Meta.get (if stat then Meta.ForwardStatics else Meta.Forward) a.a_meta in - match el with - | [] -> - true - | _ -> - List.exists (fun e -> match fst e with - | EConst(Ident s | String(s,_)) -> s = i - | _ -> error "Identifier or string expected as argument to @:forward" (pos e) - ) el - with Not_found -> - false + let type_field_by_e f e = + f e (follow_without_type e.etype) in - match follow e.etype with - | TInst (c,params) -> - let rec loop_dyn c params = - match c.cl_dynamic with - | Some t -> - let t = apply_params c.cl_params params t in - if (mode = MGet || mode = MCall) && PMap.mem "resolve" c.cl_fields then begin - let f = PMap.find "resolve" c.cl_fields in - begin match f.cf_kind with - | Method MethMacro -> display_error ctx "The macro accessor is not allowed for field resolve" f.cf_pos - | _ -> () - end; - let texpect = tfun [ctx.t.tstring] t in - let tfield = apply_params c.cl_params params (monomorphs f.cf_params f.cf_type) in - (try Type.unify tfield texpect - with Unify_error l -> - display_error ctx "Field resolve has an invalid type" f.cf_pos; - display_error ctx (error_msg (Unify [Cannot_unify(tfield,texpect)])) f.cf_pos); - AKExpr (make_call ctx (mk (TField (e,FInstance (c,params,f))) tfield p) [Texpr.type_constant ctx.com.basic (String(i,SDoubleQuotes)) p] t p) - end else - AKExpr (mk (TField (e,FDynamic i)) t p) - | None -> - match c.cl_super with - | None -> raise Not_found - | Some (c,params) -> loop_dyn c params - in - (try - let c2, t , f = class_field ctx c params i p in - if e.eexpr = TConst TSuper then (match mode,f.cf_kind with - | MGet,Var {v_read = AccCall } - | MSet,Var {v_write = AccCall } - | MCall,Var {v_read = AccCall } -> - () - | MCall, Var _ -> - display_error ctx "Cannot access superclass variable for calling: needs to be a proper method" pfield - | MCall, _ -> - () - | MGet,Var _ - | MSet,Var _ when ctx.com.platform = Flash && (match c2 with Some ({ cl_extern = true }, _) -> true | _ -> false) -> - () - | _, Method _ -> - display_error ctx "Cannot create closure on super method" p - | _ -> - display_error ctx "Normal variables cannot be accessed with 'super', use 'this' instead" pfield); - if not (can_access ctx c f false) && not ctx.untyped then display_error ctx ("Cannot access private field " ^ i) pfield; - field_access ctx mode f (match c2 with None -> FAnon f | Some (c,tl) -> FInstance (c,tl,f)) (apply_params c.cl_params params t) e p - with Not_found -> try - begin match e.eexpr with - | TConst TSuper -> raise Not_found - | _ -> using_field ctx mode e i p - end - with Not_found -> try - loop_dyn c params - with Not_found -> try - (* if we have an abstract constraint we have to check its static fields and recurse (issue #2343) *) - begin match c.cl_kind with + let rec type_field_by_list f = function + | [] -> raise Not_found + | x :: l -> try f x with Not_found -> type_field_by_list f l + in + let type_field_by_forward f meta a = + let _,el,_ = Meta.get meta a.a_meta in + if el <> [] && not (List.exists (fun e -> match fst e with + | EConst (Ident i' | String (i',_)) -> i' = i + | _ -> error "Identifier or string expected as argument to @:forward" (pos e) + ) el) then raise Not_found; + f() + in + let type_field_by_forward_static f a = + type_field_by_forward f Meta.ForwardStatics a + in + let type_field_by_forward_member f e a tl = + let f () = type_field_by_et f e (Abstract.get_underlying_type ~return_first:true a tl) in + type_field_by_forward f Meta.Forward a + in + let type_field_by_typedef f e td tl = + f e (follow_without_type (apply_params td.t_params tl td.t_type)) + in + let type_field_by_interfaces e c = + (* For extern lib types we didn't go through check_interfaces and check_abstract_class, which handles some field + generation. We instead do this lazily here by browsing the implemented interfaces (issue #9768). *) + if not (has_class_flag c CExtern && Meta.has Meta.LibType c.cl_meta) then raise Not_found; + type_field_by_list (fun (ci,tl) -> + let f, acc = class_field_with_access e ci tl in + (* It should be fine to just add the field to our class to make future lookups a bit faster. *) + TClass.add_field c f; + acc + ) c.cl_implements + in + let rec type_field_by_type e t = + let field_access = field_access e in + match t with + | TType (td,tl) -> type_field_by_typedef type_field_by_type e td tl + | TInst (c,tl) -> + (try + snd (class_field_with_access e c tl) + with Not_found -> try + match c.cl_kind with | KTypeParameter tl -> - let rec loop tl = match tl with - | t :: tl -> - begin match follow t with - | TAbstract({a_impl = Some c},tl) when PMap.mem i c.cl_statics -> - let e = mk_cast e t p in - type_field cfg ctx e i p mode; - | _ -> - loop tl - end - | [] -> - raise Not_found - in - loop tl - | _ -> - raise Not_found - end - with Not_found -> - if PMap.mem i c.cl_statics then error ("Cannot access static field " ^ i ^ " from a class instance") pfield; - no_field()) - | TDynamic t -> - (try - using_field ctx mode e i p - with Not_found -> - AKExpr (mk (TField (e,FDynamic i)) t p)) - | TAnon a -> - (try - let f = PMap.find i a.a_fields in - if Meta.has Meta.Impl f.cf_meta && not (Meta.has Meta.Enum f.cf_meta) then display_error ctx "Cannot access non-static abstract field statically" pfield; - if not (has_class_field_flag f CfPublic) && not ctx.untyped then begin + type_field_by_list (fun t -> match follow t with + | TAbstract _ -> type_field_by_e type_field_by_type (mk_cast e t p); + | _ -> raise Not_found + ) tl + | _ -> raise Not_found + with Not_found -> + type_field_by_interfaces e c + ) + | TAnon a -> + (try + let f = PMap.find i a.a_fields in + if has_class_field_flag f CfImpl && not (has_class_field_flag f CfEnum) then display_error ctx "Cannot access non-static abstract field statically" pfield; match !(a.a_status) with - | Closed | Extend _ -> () (* always allow anon private fields access *) - | Statics c when can_access ctx c f true -> () - | _ -> display_error ctx ("Cannot access private field " ^ i) pfield - end; - let fmode, ft = (match !(a.a_status) with - | Statics c -> FStatic (c,f), field_type ctx c [] f p - | EnumStatics e -> FEnum (e,try PMap.find f.cf_name e.e_constrs with Not_found -> die "" __LOC__), Type.field_type f + | EnumStatics en -> + let c = try PMap.find f.cf_name en.e_constrs with Not_found -> die "" __LOC__ in + let fmode = FEnum (en,c) in + let t = enum_field_type ctx en c p in + AKExpr (mk (TField (e,fmode)) t p) + | Statics c -> + field_access f (FHStatic c) | _ -> - match f.cf_params with - | [] -> - FAnon f, Type.field_type f - | l -> - (* handle possible constraints *) - let monos = List.map (fun _ -> mk_mono()) l in - let t = apply_params f.cf_params monos f.cf_type in - add_constraint_checks ctx [] [] f monos p; - FAnon f, t - ) in - field_access ctx mode f fmode ft e p - with Not_found -> try + field_access f FHAnon + with Not_found -> match !(a.a_status) with - | Statics {cl_kind = KAbstractImpl a} when does_forward a true -> - let mt = try module_type_of_type a.a_this with Exit -> raise Not_found in - let et = type_module_type ctx mt None p in - type_field cfg ctx et i p mode; - | _ -> - raise Not_found + | Statics { cl_kind = KAbstractImpl a } -> + type_field_by_forward_static (fun() -> + let mt = try module_type_of_type a.a_this with Exit -> raise Not_found in + let et = type_module_type ctx mt None p in + type_field_by_e type_field_by_type et + ) a + | _ -> raise Not_found + ) + | TMono r -> + let mk_field () = { + (mk_field i (mk_mono()) p null_pos) with + cf_kind = Var { v_read = AccNormal; v_write = if is_set then AccNormal else AccNo } + } in + (match Monomorph.classify_constraints r with + | CStructural (fields,is_open) -> + (try + let f = PMap.find i fields in + (match f.cf_kind with + (* We previously inferred to read-only, but now we want to write. This can happen in cases like #8079. *) + | Var ({ v_write = AccNo } as acc) when is_open && is_set -> f.cf_kind <- Var { acc with v_write = AccNormal } + | _ -> ()); + field_access f FHAnon + with Not_found when is_open -> + let f = mk_field() in + Monomorph.add_constraint r (MField f); + field_access f FHAnon + ) + | CTypes tl -> + type_field_by_list (fun (t,_) -> type_field_by_et type_field_by_type e t) tl + | CUnknown -> + if not (List.exists (fun (m,_) -> m == r) ctx.monomorphs.perfunction) && not (ctx.untyped && ctx.com.platform = Neko) then + ctx.monomorphs.perfunction <- (r,p) :: ctx.monomorphs.perfunction; + let f = mk_field() in + Monomorph.add_constraint r (MField f); + Monomorph.add_constraint r MOpenStructure; + field_access f FHAnon + ) + | TAbstract (a,tl) -> + (try + let c = find_some a.a_impl in + let f = PMap.find i c.cl_statics in + if not (has_class_field_flag f CfImpl) then raise Not_found; + field_access f (FHAbstract (a,tl,c)) with Not_found -> - if is_closed a then try - using_field ctx mode e i p - with Not_found -> - no_field() - else - let f = { - (mk_field i (mk_mono()) p null_pos) with - cf_kind = Var { v_read = AccNormal; v_write = (match mode with MSet -> AccNormal | MGet | MCall -> AccNo) }; - } in - a.a_fields <- PMap.add i f a.a_fields; - field_access ctx mode f (FAnon f) (Type.field_type f) e p - ) - | TMono r -> - let f = { - (mk_field i (mk_mono()) p null_pos) with - cf_kind = Var { v_read = AccNormal; v_write = (match mode with MSet -> AccNormal | MGet | MCall -> AccNo) }; - } in - let x = ref Opened in - let t = mk_anon ~fields:(PMap.add i f PMap.empty) x in - ctx.opened <- x :: ctx.opened; - Monomorph.bind r t; - field_access ctx mode f (FAnon f) (Type.field_type f) e p - | TAbstract (a,pl) -> - let static_abstract_access_through_instance = ref false in - (try - let c = (match a.a_impl with None -> raise Not_found | Some c -> c) in - let f = PMap.find i c.cl_statics in - if not (can_access ctx c f true) && not ctx.untyped then display_error ctx ("Cannot access private field " ^ i) pfield; - let field_type f = - if not (Meta.has Meta.Impl f.cf_meta) then begin - static_abstract_access_through_instance := true; - raise Not_found; - end; - let t = field_type ctx c [] f p in - apply_params a.a_params pl t + type_field_by_forward_member type_field_by_type e a tl + ) + | _ -> raise Not_found + in + let type_field_by_extension f t e = + let check_constant_struct = ref false in + let e = match t with + | TInst _ when e.eexpr = TConst TSuper -> { e with eexpr = TCast(mk (TConst TThis) (mk_mono()) e.epos,None) } + | _ -> e + in + let loop = type_field_by_list (fun (c,pc) -> + let cf0 = PMap.find i c.cl_statics in + let rec check cfl = match cfl with + | [] -> + raise Not_found + | cf :: cfl when Meta.has Meta.NoUsing cf.cf_meta || not (can_access ctx c cf true) || (has_class_field_flag cf CfImpl) -> + check cfl + | cf :: cfl -> + (* We always want to reset monomorphs here because they will be handled again when making the actual call. *) + let current_monos = ctx.monomorphs.perfunction in + let check () = + ctx.monomorphs.perfunction <- current_monos; + check cfl + in + try + let monos = Monomorph.spawn_constrained_monos (fun t -> t) cf.cf_params in + let cft = follow (apply_params cf.cf_params monos cf.cf_type) in + match cft with + | TFun ((_,_,(TType ({ t_path = ["haxe";"macro"],"ExprOf" },[t0]) | t0)) :: _,_) -> + if t == t_dynamic && follow t0 != t then + check() + else begin + let e = unify_static_extension ctx e t0 p in + ImportHandling.mark_import_position ctx pc; + ctx.monomorphs.perfunction <- current_monos; + AKUsingField (make_static_extension_access c cf e false p) + end + | _ -> + check() + with Unify_error el | Error (Unify el,_) -> + check_constant_struct := !check_constant_struct || List.exists (function + | Has_extra_field _ -> true + | _ -> false + ) el; + check() in - let et = type_module_type ctx (TClassDecl c) None p in - let field_expr f t = mk (TField (et,FStatic (c,f))) t p in - (match mode, f.cf_kind with - | (MGet | MCall), Var {v_read = AccCall } when ctx.in_display && DisplayPosition.display_position#enclosed_in p -> - let ef = field_expr f (field_type f) in - AKExpr(ef) - | (MGet | MCall), Var {v_read = AccCall } -> - (* getter call *) - let getter = PMap.find ("get_" ^ f.cf_name) c.cl_statics in - let t = field_type getter in - let r = match follow t with TFun(_,_) -> field_type f | _ -> raise Not_found in - let ef = field_expr getter t in - AKExpr(make_call ctx ef [e] r p) - | MSet, Var {v_write = AccCall } -> - let f = PMap.find ("set_" ^ f.cf_name) c.cl_statics in - let t = field_type f in - let ef = field_expr f t in - AKUsing (ef,c,f,e,false) - | (MGet | MCall), Var {v_read = AccNever} -> - AKNo f.cf_name - | (MGet | MCall), _ -> - let rec loop cfl = match cfl with - | [] -> error (Printf.sprintf "Field %s cannot be called on %s" f.cf_name (s_type (print_context()) e.etype)) pfield - | cf :: cfl -> - match follow (apply_params a.a_params pl (monomorphs cf.cf_params cf.cf_type)) with - | TFun((_,_,t1) :: _,_) when type_iseq t1 (Abstract.get_underlying_type a pl) -> - cf - | _ -> - loop cfl - in - let f = match f.cf_overloads with - | [] -> f - | cfl -> loop (f :: cfl) - in - let t = field_type f in - begin match follow t with - | TFun((_,_,t1) :: _,_) -> () - | _ -> error ("Invalid call to static function " ^ i ^ " through abstract instance") pfield - end; - let ef = field_expr f t in - AKUsing (ef,c,f,e,false) - | MSet, _ -> - error "This operation is unsupported" p) - with Not_found -> try - if does_forward a false then - let underlying_type = Abstract.get_underlying_type ~return_first:true a pl in - type_field (TypeFieldConfig.with_resume cfg) ctx {e with etype = underlying_type} i p mode - else - raise Not_found - with Not_found -> try - using_field ctx mode e i p - with Not_found -> try - (match ctx.curfun, e.eexpr with - | FunMemberAbstract, TConst (TThis) -> type_field cfg ctx {e with etype = apply_params a.a_params pl a.a_this} i p mode; - | _ -> raise Not_found) - with Not_found -> try - let get_resolve is_write = - let c,cf = match a.a_impl,(if is_write then a.a_write else a.a_read) with - | Some c,Some cf -> c,cf + check (cf0 :: cf0.cf_overloads) + ) in + try + f loop + with Not_found when !check_constant_struct -> + remove_constant_flag t (function + | true -> f loop + | false -> raise Not_found) + in + let rec type_field_by_type_extension e t = + if is_set then raise Not_found; + let type_field_by_extension () = type_field_by_extension (fun loop -> + let mt = try module_type_of_type t with Exit -> raise Not_found in + loop (t_infos mt).mt_using + ) t e in + match t with + | TType (td,tl) -> + (try + type_field_by_extension() + with Not_found -> + type_field_by_typedef type_field_by_type_extension e td tl + ) + | TMono _ -> raise Not_found + | TAbstract (a,tl) -> + (try + type_field_by_extension() + with Not_found -> + type_field_by_forward_member type_field_by_type_extension e a tl + ) + | _ -> type_field_by_extension() + in + let rec type_field_by_module_extension e t = + if is_set then raise Not_found; + let type_field_by_extension () = type_field_by_extension (fun loop -> + try + loop ctx.m.module_using + with Not_found -> + match loop ctx.g.global_using with + | AKUsingField { se_access = { fa_host = FHStatic c } } as acc -> + add_dependency ctx.m.curmod c.cl_module; + acc + | _ -> die "" __LOC__ + ) t e in + match t with + | TType (td,tl) -> type_field_by_typedef type_field_by_module_extension e td tl + | TMono r -> + (match Monomorph.classify_constraints r with + | CStructural (_,is_open) when not is_open -> type_field_by_extension() + | _ -> raise Not_found + ) + | TAbstract (a,tl) -> + (try + type_field_by_extension() + with Not_found -> + type_field_by_forward_member type_field_by_module_extension e a tl + ) + | _ -> type_field_by_extension() + in + let rec type_field_by_fallback e t = + match t with + | TType (td,tl) -> type_field_by_typedef type_field_by_fallback e td tl + | TInst (c,tl) -> + (try + let rec loop c tl = match c with + | { cl_dynamic = Some t } -> AKExpr (mk (TField (e,FDynamic i)) (apply_params c.cl_params tl t) p) + | { cl_super = Some (c,tl) } -> loop c tl | _ -> raise Not_found in - let et = type_module_type ctx (TClassDecl c) None p in - let t = apply_params a.a_params pl (field_type ctx c [] cf p) in - let ef = mk (TField (et,FStatic (c,cf))) t p in - let r = match follow t with - | TFun(_,r) -> r - | _ -> die "" __LOC__ - in - if is_write then - AKFieldSet(e,ef,i,r) - else - AKExpr ((!build_call_ref) ctx (AKUsing(ef,c,cf,e,false)) [EConst (String(i,SDoubleQuotes)),p] NoValue p) + loop c tl + with Not_found when PMap.mem i c.cl_statics -> + error ("Cannot access static field " ^ i ^ " from a class instance") pfield; + ) + | TDynamic t -> + AKExpr (mk (TField (e,FDynamic i)) t p) + | TAbstract (a,tl) -> + (try + if not (TypeFieldConfig.allow_resolve cfg) then raise Not_found; + let c = find_some a.a_impl in + let f = find_some (if is_set then a.a_write else a.a_read) in + let sea = make_abstract_static_extension_access a tl c f e false p in + AKResolve(sea,i) + with Not_found -> try + type_field_by_forward_member type_field_by_fallback e a tl + with Not_found when not (has_class_field_flag (PMap.find i (find_some a.a_impl).cl_statics) CfImpl) -> + error ("Invalid call to static function " ^ i ^ " through abstract instance") pfield + ) + | _ -> raise Not_found + in + let t = follow_without_type e.etype in + try + type_field_by_type e t + with Not_found -> try + type_field_by_type_extension e t + with Not_found -> try + type_field_by_module_extension e t + with Not_found -> try + type_field_by_fallback e t + with Not_found when not (TypeFieldConfig.do_resume cfg) -> + if not ctx.untyped then begin + let has_special_field a = + List.exists (fun (_,cf) -> cf.cf_name = i) a.a_ops + || List.exists (fun (_,_,cf) -> cf.cf_name = i) a.a_unops + || List.exists (fun cf -> cf.cf_name = i) a.a_array in - if not (TypeFieldConfig.allow_resolve cfg) then raise Not_found; - get_resolve (mode = MSet) - with Not_found -> - if !static_abstract_access_through_instance then error ("Invalid call to static function " ^ i ^ " through abstract instance") pfield - else no_field()) - | _ -> - try using_field ctx mode e i p with Not_found -> no_field() + match follow t with + | TAnon { a_status = { contents = Statics { cl_kind = KAbstractImpl a } } } + | TInst ({ cl_kind = KAbstractImpl a },_) + | TAbstract (a,_) when has_special_field a -> + (* the abstract field is not part of the field list, which is only true when it has no expression (issue #2344) *) + display_error ctx ("Field " ^ i ^ " cannot be called directly because it has no expression") pfield; + | TAnon { a_status = { contents = Statics c } } when PMap.mem i c.cl_fields -> + display_error ctx ("Static access to instance field " ^ i ^ " is not allowed") pfield; + | _ -> + let tthis = e.etype in + try + if not (Diagnostics.is_diagnostics_run ctx.com pfield) then raise Exit; + DisplayFields.handle_missing_field_raise ctx tthis i mode with_type pfield + with Exit -> + display_error ctx (StringError.string_error i (string_source tthis) (s_type (print_context()) tthis ^ " has no field " ^ i)) pfield + end; + AKExpr (mk (TField (e,FDynamic i)) (spawn_monomorph ctx p) p) let type_field_default_cfg = type_field TypeFieldConfig.default @@ -635,17 +563,27 @@ let get_struct_init_anon_fields c tl = let args = match c.cl_constructor with | Some cf -> + let javadoc = match gen_doc_text_opt cf.cf_doc with + | None -> None + | Some s -> Some (new Javadoc.javadoc s) + in + let extract_param_info name = match javadoc with + | Some javadoc -> javadoc#get_param_info name + | None -> None + in (match follow cf.cf_type with | TFun (args,_) -> Some (match cf.cf_expr with | Some { eexpr = TFunction fn } -> List.map (fun (name,_,t) -> let t = apply_params c.cl_params tl t in - try + let p = try let v,_ = List.find (fun (v,_) -> v.v_name = name) fn.tf_args in - name,t,v.v_pos + v.v_pos with Not_found -> - name,t,cf.cf_name_pos + cf.cf_name_pos + in + name,t,p,extract_param_info name ) args | _ -> List.map @@ -653,9 +591,9 @@ let get_struct_init_anon_fields c tl = let t = apply_params c.cl_params tl t in try let cf = PMap.find name c.cl_fields in - name,t,cf.cf_name_pos + name,t,cf.cf_name_pos,gen_doc_text_opt cf.cf_doc with Not_found -> - name,t,cf.cf_name_pos + name,t,cf.cf_name_pos,extract_param_info name ) args ) | _ -> None @@ -664,8 +602,9 @@ let get_struct_init_anon_fields c tl = in match args with | Some args -> - List.fold_left (fun fields (name,t,p) -> + List.fold_left (fun fields (name,t,p,doc) -> let cf = mk_field name t p p in + cf.cf_doc <- (doc_from_string_opt doc); PMap.add cf.cf_name cf fields ) PMap.empty args | _ -> diff --git a/src/typing/finalization.ml b/src/typing/finalization.ml index 71334340..88872adf 100644 --- a/src/typing/finalization.ml +++ b/src/typing/finalization.ml @@ -12,35 +12,78 @@ open Typecore let get_main ctx types = match ctx.com.main_class with | None -> None - | Some cl -> - let t = Typeload.load_type_def ctx null_pos (mk_type_path cl) in - let fmode, ft, r = (match t with - | TEnumDecl _ | TTypeDecl _ | TAbstractDecl _ -> - error ("Invalid -main : " ^ s_type_path cl ^ " is not a class") null_pos - | TClassDecl c -> + | Some path -> + let p = null_pos in + let pack,name = path in + let m = Typeload.load_module ctx (pack,name) p in + let c,f = + let p = ref p in try - let f = PMap.find "main" c.cl_statics in - let t = Type.field_type f in - (match follow t with - | TFun ([],r) -> FStatic (c,f), t, r - | _ -> error ("Invalid -main : " ^ s_type_path cl ^ " has invalid main function") c.cl_pos); - with - Not_found -> error ("Invalid -main : " ^ s_type_path cl ^ " does not have static function main") c.cl_pos - ) in - let emain = type_type ctx cl null_pos in + match m.m_statics with + | None -> + raise Not_found + | Some c -> + p := c.cl_pos; + c, PMap.find "main" c.cl_statics + with Not_found -> try + let t = Typeload.find_type_in_module_raise ctx m name null_pos in + match t with + | TEnumDecl _ | TTypeDecl _ | TAbstractDecl _ -> + error ("Invalid -main : " ^ s_type_path path ^ " is not a class") null_pos + | TClassDecl c -> + p := c.cl_pos; + c, PMap.find "main" c.cl_statics + with Not_found -> + error ("Invalid -main : " ^ s_type_path path ^ " does not have static function main") !p + in + let ft = Type.field_type f in + let fmode, r = + match follow ft with + | TFun ([],r) -> FStatic (c,f), r + | _ -> error ("Invalid -main : " ^ s_type_path path ^ " has invalid main function") c.cl_pos + in + if not (ExtType.is_void (follow r)) then error (Printf.sprintf "Return type of main function should be Void (found %s)" (s_type (print_context()) r)) f.cf_name_pos; + f.cf_meta <- (Dce.mk_keep_meta f.cf_pos) :: f.cf_meta; + let emain = type_module_type ctx (TClassDecl c) None null_pos in let main = mk (TCall (mk (TField (emain,fmode)) ft null_pos,[])) r null_pos in - (* add haxe.EntryPoint.run() call *) - let main = (try - let et = List.find (fun t -> t_path t = (["haxe"],"EntryPoint")) types in + let call_static path method_name = + let et = List.find (fun t -> t_path t = path) types in let ec = (match et with TClassDecl c -> c | _ -> die "" __LOC__) in - let ef = PMap.find "run" ec.cl_statics in - let p = null_pos in - let et = mk (TTypeExpr et) (mk_anon (ref (Statics ec))) p in - let call = mk (TCall (mk (TField (et,FStatic (ec,ef))) ef.cf_type p,[])) ctx.t.tvoid p in - mk (TBlock [main;call]) ctx.t.tvoid p - with Not_found -> - main - ) in + let ef = PMap.find method_name ec.cl_statics in + let et = mk (TTypeExpr et) (mk_anon (ref (Statics ec))) null_pos in + mk (TCall (mk (TField (et,FStatic (ec,ef))) ef.cf_type null_pos,[])) ctx.t.tvoid null_pos + in + (* add haxe.EntryPoint.run() call *) + let add_entry_point_run main = + try + [main; call_static (["haxe"],"EntryPoint") "run"] + with Not_found -> + [main] + and add_entry_point_init main = + try + [call_static (["haxe"],"EntryPoint") "init"; main] + with Not_found -> + [main] + in + (* add calls for event loop *) + let add_event_loop main = + (try + let thread = (["sys";"thread";"_Thread"],"Thread_Impl_") in + call_static thread "initEventLoop" :: add_entry_point_init main @ [call_static thread "processEvents"] + with Not_found -> + [main] + ) + in + let main = + (* Threaded targets run event loops per thread *) + let exprs = + if ctx.com.config.pf_supports_threads then add_event_loop main + else add_entry_point_run main + in + match exprs with + | [e] -> e + | _ -> mk (TBlock exprs) ctx.t.tvoid p + in Some main let finalize ctx = diff --git a/src/typing/forLoop.ml b/src/typing/forLoop.ml index 51e64caf..d0da20f0 100644 --- a/src/typing/forLoop.ml +++ b/src/typing/forLoop.ml @@ -5,6 +5,7 @@ open Common open Typecore open TyperBase open Fields +open Calls open Error open Texpr.Builder @@ -103,7 +104,7 @@ module IterationKind = struct after() in let try_acc acc = - let acc_expr = !build_call_ref ctx acc [] WithType.value e.epos in + let acc_expr = build_call ctx acc [] WithType.value e.epos in try unify_raise ctx acc_expr.etype t acc_expr.epos; acc_expr @@ -119,14 +120,14 @@ module IterationKind = struct ) in try - let acc = type_field ({do_resume = true;allow_resolve = false}) ctx e s e.epos MCall in + let acc = type_field ({do_resume = true;allow_resolve = false}) ctx e s e.epos (MCall []) (WithType.with_type t) in try_acc acc; with Not_found -> try_last_resort (fun () -> match !dynamic_iterator with | Some e -> e | None -> - let acc = type_field ({do_resume = resume;allow_resolve = false}) ctx e s e.epos MCall in + let acc = type_field ({do_resume = resume;allow_resolve = false}) ctx e s e.epos (MCall []) (WithType.with_type t) in try_acc acc ) in @@ -232,15 +233,15 @@ module IterationKind = struct (try let v_tmp = gen_local ctx e.etype e.epos in let e_tmp = make_local v_tmp v_tmp.v_pos in - let acc_next = type_field type_field_config ctx e_tmp "next" p MCall in - let acc_hasNext = type_field type_field_config ctx e_tmp "hasNext" p MCall in + let acc_next = type_field type_field_config ctx e_tmp "next" p (MCall []) WithType.value (* WITHTYPETODO *) in + let acc_hasNext = type_field type_field_config ctx e_tmp "hasNext" p (MCall []) (WithType.with_type ctx.t.tbool) in (match acc_next, acc_hasNext with | AKExpr({ eexpr = TField(_, FDynamic _)}), _ | _, AKExpr({ eexpr = TField(_, FDynamic _)}) -> raise Not_found | _ -> () ); - let e_next = !build_call_ref ctx acc_next [] WithType.value e.epos in - let e_hasNext = !build_call_ref ctx acc_hasNext [] WithType.value e.epos in + let e_next = build_call ctx acc_next [] WithType.value e.epos in + let e_hasNext = build_call ctx acc_hasNext [] WithType.value e.epos in IteratorAbstract(v_tmp,e_next,e_hasNext),e,e_next.etype with Not_found -> (try try_forward_array_iterator () @@ -471,7 +472,7 @@ let type_for_loop ctx handle_display it e2 p = | EBinop(OpArrow,ei1,(EBinop(OpIn,ei2,e2),_)) -> IKKeyValue(loop_ident None ei1,loop_ident None ei2),e2 | _ -> begin match dko with - | Some dk -> ignore(handle_display ctx e1 dk WithType.value); + | Some dk -> ignore(handle_display ctx e1 dk MGet WithType.value); | None -> () end; error "For expression should be 'v in expr'" (snd it) @@ -484,7 +485,7 @@ let type_for_loop ctx handle_display it e2 p = let e2 = Expr.ensure_block e2 in let check_display (i,pi,dko) = match dko with | None -> () - | Some dk -> ignore(handle_display ctx (EConst(Ident i.v_name),i.v_pos) dk (WithType.with_type i.v_type)) + | Some dk -> ignore(handle_display ctx (EConst(Ident i.v_name),i.v_pos) dk MGet (WithType.with_type i.v_type)) in match ik with | IKNormal(i,pi,dko) -> @@ -508,12 +509,12 @@ let type_for_loop ctx handle_display it e2 p = let e1,pt = IterationKind.check_iterator ctx "keyValueIterator" e1 e1.epos in let vtmp = gen_local ctx e1.etype e1.epos in let etmp = make_local vtmp vtmp.v_pos in - let ehasnext = !build_call_ref ctx (type_field_default_cfg ctx etmp "hasNext" etmp.epos MCall) [] WithType.value etmp.epos in - let enext = !build_call_ref ctx (type_field_default_cfg ctx etmp "next" etmp.epos MCall) [] WithType.value etmp.epos in + let ehasnext = build_call ctx (type_field_default_cfg ctx etmp "hasNext" etmp.epos (MCall []) (WithType.with_type ctx.t.tbool)) [] WithType.value etmp.epos in + let enext = build_call ctx (type_field_default_cfg ctx etmp "next" etmp.epos (MCall []) WithType.value (* WITHTYPETODO *)) [] WithType.value etmp.epos in let v = gen_local ctx pt e1.epos in let ev = make_local v v.v_pos in - let ekey = Calls.acc_get ctx (type_field_default_cfg ctx ev "key" ev.epos MGet) ev.epos in - let evalue = Calls.acc_get ctx (type_field_default_cfg ctx ev "value" ev.epos MGet) ev.epos in + let ekey = Calls.acc_get ctx (type_field_default_cfg ctx ev "key" ev.epos MGet WithType.value) ev.epos in + let evalue = Calls.acc_get ctx (type_field_default_cfg ctx ev "value" ev.epos MGet WithType.value) ev.epos in let vkey = add_local_with_origin ctx TVOForVariable ikey ekey.etype pkey in let vvalue = add_local_with_origin ctx TVOForVariable ivalue evalue.etype pvalue in let e2 = type_expr ctx e2 NoValue in diff --git a/src/typing/functionArguments.ml b/src/typing/functionArguments.ml new file mode 100644 index 00000000..5de946ec --- /dev/null +++ b/src/typing/functionArguments.ml @@ -0,0 +1,153 @@ +open Globals +open Ast +open Type +open Typecore +open Error + +let type_opt ctx is_core_api is_abstract_method p t = + let c = ctx.curclass in + match t with + | None when (has_class_flag c CExtern) || (has_class_flag c CInterface) -> + display_error ctx "Type required for extern classes and interfaces" p; + t_dynamic + | None when is_core_api -> + display_error ctx "Type required for core api classes" p; + t_dynamic + | None when is_abstract_method -> + display_error ctx "Type required for abstract functions" p; + t_dynamic + | _ -> + Typeload.load_type_hint ctx p t + +let type_function_arg ctx t e opt p = + (* TODO https://github.com/HaxeFoundation/haxe/issues/8461 *) + (* delay ctx PTypeField (fun() -> + if ExtType.is_void (follow t) then + error "Arguments of type Void are not allowed" p + ); *) + if opt then + let e = (match e with None -> Some (EConst (Ident "null"),null_pos) | _ -> e) in + ctx.t.tnull t, e + else + let t = match e with Some (EConst (Ident "null"),null_pos) -> ctx.t.tnull t | _ -> t in + t, e + +let type_function_arg_value ctx t c do_display = + match c with + | None -> None + | Some e -> + let p = pos e in + let e = if do_display then Display.ExprPreprocessing.process_expr ctx.com e else e in + let e = ctx.g.do_optimize ctx (type_expr ctx e (WithType.with_type t)) in + unify ctx e.etype t p; + let rec loop e = match e.eexpr with + | TConst _ -> Some e + | TField({eexpr = TTypeExpr _},FEnum _) -> Some e + | TField({eexpr = TTypeExpr _},FStatic({cl_kind = KAbstractImpl a},cf)) when a.a_enum && has_class_field_flag cf CfEnum -> Some e + | TCast(e,None) -> loop e + | _ -> + if ctx.com.display.dms_kind = DMNone || ctx.com.display.dms_inline && ctx.com.display.dms_error_policy = EPCollect then + display_error ctx "Parameter default value should be constant" p; + None + in + loop e + +class function_arguments + (ctx : typer) + (type_arg : bool -> type_hint option -> pos -> Type.t) + (is_extern : bool) + (do_display : bool) + (abstract_this : Type.t option) + (syntax : (placed_name * bool * metadata * type_hint option * expr option) list) += + let with_default = + let l = List.map (fun ((name,pn),opt,m,t,eo) -> + let t = type_arg opt t pn in + let t,eo = type_function_arg ctx t eo opt pn in + (name,eo,t) + ) syntax in + let l = match abstract_this with + | None -> + l + | Some t -> + ("this",None,t) :: l + in + l + in + +object(self) + + val mutable type_repr = None + val mutable expr_repr = None + + (* Returns the `(string * bool * Type.t) list` requires by `TFun` .*) + method for_type = match type_repr with + | Some l -> + l + | None -> + let l = List.map (fun (n,eo,t) -> n,eo <> None,t) with_default in + type_repr <- Some l; + l + + method private check_rest (is_last : bool) (eo : expr option) (opt : bool) (t : Type.t) (pn : pos) = + if ExtType.is_rest (follow t) then begin + if opt then error "Rest argument cannot be optional" pn; + begin match eo with None -> () | Some (_,p) -> error "Rest argument cannot have default value" p end; + if not is_last then error "Rest should only be used for the last function argument" pn; + end + + (* Returns the `(tvar * texpr option) list` for `tf_args`. Also checks the validity of argument names and whether or not + an argument should be displayed. *) + method for_expr = match expr_repr with + | Some l -> + l + | None -> + let make_local name t meta pn = + let v = alloc_var (VUser TVOArgument) name t pn in + v.v_meta <- v.v_meta @ meta; + v + in + let rec loop acc is_abstract_this syntax typed = match syntax,typed with + | syntax,(name,_,t) :: typed when is_abstract_this -> + let v = make_local name t [] null_pos in + v.v_meta <- (Meta.This,[],null_pos) :: v.v_meta; + loop ((v,None) :: acc) false syntax typed + | ((_,pn),opt,m,_,_) :: syntax,(name,eo,t) :: typed -> + delay ctx PTypeField (fun() -> self#check_rest (typed = []) eo opt t pn); + if not is_extern then check_local_variable_name ctx name TVOArgument pn; + let eo = type_function_arg_value ctx t eo do_display in + let v = make_local name t m pn in + if do_display && DisplayPosition.display_position#enclosed_in pn then + DisplayEmitter.display_variable ctx v pn; + loop ((v,eo) :: acc) false syntax typed + | [],[] -> + List.rev acc + | _ -> + die "" __LOC__ + in + let l = loop [] (abstract_this <> None) syntax with_default in + expr_repr <- Some l; + l + + (* Verifies the validity of any argument typed as `haxe.extern.Rest` and checks default values. *) + method verify_extern = + let rec loop is_abstract_this syntax typed = match syntax,typed with + | syntax,(name,_,t) :: typed when is_abstract_this -> + loop false syntax typed + | ((_,pn),opt,m,_,_) :: syntax,(name,eo,t) :: typed -> + delay ctx PTypeField (fun() -> self#check_rest (typed = []) eo opt t pn); + ignore(type_function_arg_value ctx t eo do_display); + loop false syntax typed + | [],[] -> + () + | _ -> + die "" __LOC__ + in + loop (abstract_this <> None) syntax with_default + + (* Brings arguments into context by adding them to `ctx.locals`. *) + method bring_into_context = + List.iter (fun (v,_) -> + ctx.locals <- PMap.add v.v_name v ctx.locals + ) self#for_expr +end \ No newline at end of file diff --git a/src/typing/generic.ml b/src/typing/generic.ml index 5d5bcf2a..330878bd 100644 --- a/src/typing/generic.ml +++ b/src/typing/generic.ml @@ -99,7 +99,7 @@ let generic_substitute_expr gctx e = v2 in let rec build_expr e = - match e.eexpr with + let e = match e.eexpr with | TField(e1, FInstance({cl_kind = KGeneric} as c,tl,cf)) -> let _, _, f = gctx.ctx.g.do_build_instance gctx.ctx (TClassDecl c) gctx.p in let t = f (List.map (generic_substitute_type gctx) tl) in @@ -135,6 +135,8 @@ let generic_substitute_expr gctx e = end | _ -> map_expr_type build_expr (generic_substitute_type gctx) build_var e + in + CallUnification.maybe_reapply_overload_call gctx.ctx e in build_expr e @@ -160,6 +162,7 @@ let static_method_container gctx c cf p = m_id = alloc_mid(); m_path = (pack,name); m_types = []; + m_statics = None; m_extra = module_extra (s_type_path (pack,name)) m.m_extra.m_sign 0. MFake m.m_extra.m_check_policy; } in gctx.mg <- Some mg; @@ -205,6 +208,7 @@ let rec build_generic ctx c p tl = m_id = alloc_mid(); m_path = (pack,name); m_types = []; + m_statics = None; m_extra = module_extra (s_type_path (pack,name)) m.m_extra.m_sign 0. MFake m.m_extra.m_check_policy; } in gctx.mg <- Some mg; @@ -267,7 +271,7 @@ let rec build_generic ctx c p tl = begin try (match cf_old.cf_expr with | None -> begin match cf_old.cf_kind with - | Method _ when not c.cl_interface && not c.cl_extern -> + | Method _ when not (has_class_flag c CInterface) && not (has_class_flag c CExtern) -> display_error ctx (Printf.sprintf "Field %s has no expression (possible typing order issue)" cf_new.cf_name) cf_new.cf_pos; display_error ctx (Printf.sprintf "While building %s" (s_type_path cg.cl_path)) p; | _ -> @@ -281,7 +285,7 @@ let rec build_generic ctx c p tl = t in let r = exc_protect ctx (fun r -> - let t = mk_mono() in + let t = spawn_monomorph ctx p in r := lazy_processing (fun() -> t); let t0 = f() in unify_raise ctx t0 t p; @@ -312,7 +316,7 @@ let rec build_generic ctx c p tl = cg.cl_kind <- KGenericInstance (c,tl); cg.cl_meta <- (Meta.NoDoc,[],null_pos) :: cg.cl_meta; if has_meta Meta.Keep c.cl_meta then cg.cl_meta <- (Meta.Keep,[],null_pos) :: cg.cl_meta; - cg.cl_interface <- c.cl_interface; + if (has_class_flag c CInterface) then add_class_flag cg CInterface; cg.cl_constructor <- (match cg.cl_constructor, c.cl_constructor, c.cl_super with | _, Some cf, _ -> Some (build_field cf) | Some ctor, _, _ -> Some ctor @@ -329,9 +333,6 @@ let rec build_generic ctx c p tl = cg.cl_fields <- PMap.add f.cf_name f cg.cl_fields; f ) c.cl_ordered_fields; - cg.cl_overrides <- List.map (fun f -> - try PMap.find f.cf_name cg.cl_fields with Not_found -> die "" __LOC__ - ) c.cl_overrides; (* In rare cases the class name can become too long, so let's shorten it (issue #3090). *) if String.length (snd cg.cl_path) > 254 then begin let n = get_short_name () in @@ -339,3 +340,116 @@ let rec build_generic ctx c p tl = end; TInst (cg,[]) end + +let type_generic_function ctx fa el_typed el with_type p = + let c,stat = match fa.fa_host with + | FHInstance(c,tl) -> c,false + | FHStatic c -> c,true + | FHAbstract(a,tl,c) -> c,true + | _ -> die "" __LOC__ + in + let cf = fa.fa_field in + if cf.cf_params = [] then error "Function has no type parameters and cannot be generic" p; + let fcc = CallUnification.unify_field_call ctx fa el_typed el p false in + begin match with_type with + | WithType.WithType(t,_) -> unify ctx fcc.fc_ret t p + | _ -> () + end; + let monos = fcc.fc_monos in + List.iter (fun t -> match follow t with + | TMono m -> safe_mono_close ctx m p + | _ -> () + ) monos; + let el = fcc.fc_args in + (try + let gctx = make_generic ctx cf.cf_params monos p in + let name = cf.cf_name ^ "_" ^ gctx.name in + let unify_existing_field tcf pcf = try + unify_raise ctx tcf fcc.fc_type p + with Error(Unify _,_) as err -> + display_error ctx ("Cannot create field " ^ name ^ " due to type mismatch") p; + display_error ctx (compl_msg "Conflicting field was defined here") pcf; + raise err + in + let fa = try + let cf2 = if stat then + let cf2 = PMap.find name c.cl_statics in + unify_existing_field cf2.cf_type cf2.cf_pos; + cf2 + else + let cf2 = PMap.find name c.cl_fields in + unify_existing_field cf2.cf_type cf2.cf_pos; + cf2 + in + {fa with fa_field = cf2} + (* + java.Lib.array() relies on the ability to shadow @:generic function for certain types + see https://github.com/HaxeFoundation/haxe/issues/8393#issuecomment-508685760 + *) + (* if cf.cf_name_pos = cf2.cf_name_pos then + cf2 + else + error ("Cannot specialize @:generic because the generated function name is already used: " ^ name) p *) + with Not_found -> + let finalize_field c cf2 = + ignore(follow cf.cf_type); + let rec check e = match e.eexpr with + | TNew({cl_kind = KTypeParameter _} as c,_,_) when not (TypeloadCheck.is_generic_parameter ctx c) -> + display_error ctx "Only generic type parameters can be constructed" e.epos; + display_error ctx "While specializing this call" p; + | _ -> + Type.iter check e + in + cf2.cf_expr <- (match cf.cf_expr with + | None -> + display_error ctx "Recursive @:generic function" p; None; + | Some e -> + let e = generic_substitute_expr gctx e in + check e; + Some e + ); + cf2.cf_kind <- cf.cf_kind; + if not (has_class_field_flag cf CfPublic) then remove_class_field_flag cf2 CfPublic; + cf2.cf_meta <- (Meta.NoCompletion,[],p) :: (Meta.NoUsing,[],p) :: (Meta.GenericInstance,[],p) :: cf.cf_meta + in + let mk_cf2 name = + mk_field ~static:stat name fcc.fc_type cf.cf_pos cf.cf_name_pos + in + if stat then begin + if Meta.has Meta.GenericClassPerMethod c.cl_meta then begin + let c = static_method_container gctx c cf p in + let cf2 = try + let cf2 = PMap.find cf.cf_name c.cl_statics in + unify_existing_field cf2.cf_type cf2.cf_pos; + cf2 + with Not_found -> + let cf2 = mk_cf2 cf.cf_name in + c.cl_statics <- PMap.add cf2.cf_name cf2 c.cl_statics; + c.cl_ordered_statics <- cf2 :: c.cl_ordered_statics; + finalize_field c cf2; + cf2 + in + {fa with fa_host = FHStatic c;fa_field = cf2;fa_on = Builder.make_static_this c p} + end else begin + let cf2 = mk_cf2 name in + c.cl_statics <- PMap.add cf2.cf_name cf2 c.cl_statics; + c.cl_ordered_statics <- cf2 :: c.cl_ordered_statics; + finalize_field c cf2; + {fa with fa_field = cf2} + end + end else begin + let cf2 = mk_cf2 name in + if has_class_field_flag cf CfOverride then add_class_field_flag cf2 CfOverride; + c.cl_fields <- PMap.add cf2.cf_name cf2 c.cl_fields; + c.cl_ordered_fields <- cf2 :: c.cl_ordered_fields; + finalize_field c cf2; + {fa with fa_field = cf2} + end + in + let e = FieldAccess.get_field_expr fa FCall in + make_call ctx e el fcc.fc_ret p + with Generic_Exception (msg,p) -> + error msg p) + +;; +Typecore.type_generic_function_ref := type_generic_function \ No newline at end of file diff --git a/src/typing/instanceBuilder.ml b/src/typing/instanceBuilder.ml index 9d69007b..f2f11dd9 100644 --- a/src/typing/instanceBuilder.ml +++ b/src/typing/instanceBuilder.ml @@ -39,7 +39,7 @@ let build_macro_type ctx pl p = ) in let old = ctx.ret in let t = (match ctx.g.do_macro ctx MMacroType path field args p with - | None -> mk_mono() + | None -> spawn_monomorph ctx p | Some _ -> ctx.ret ) in ctx.ret <- old; @@ -58,7 +58,7 @@ let build_macro_build ctx c pl cfl p = let old = ctx.ret,ctx.get_build_infos in ctx.get_build_infos <- (fun() -> Some (TClassDecl c, pl, cfl)); let t = (match ctx.g.do_macro ctx MMacroType path field args p with - | None -> mk_mono() + | None -> spawn_monomorph ctx p | Some _ -> ctx.ret ) in ctx.ret <- fst old; @@ -74,7 +74,7 @@ let build_instance ctx mtype p = if ctx.pass > PBuildClass then ignore(c.cl_build()); let build f s = let r = exc_protect ctx (fun r -> - let t = mk_mono() in + let t = spawn_monomorph ctx p in r := lazy_processing (fun() -> t); let tf = (f()) in unify_raise ctx tf t p; diff --git a/src/typing/macroContext.ml b/src/typing/macroContext.ml index 64c7ca68..fa438420 100644 --- a/src/typing/macroContext.ml +++ b/src/typing/macroContext.ml @@ -126,21 +126,16 @@ let load_macro_ref : (typer -> bool -> path -> string -> pos -> (typer * ((strin let make_macro_api ctx p = let parse_expr_string s p inl = typing_timer ctx false (fun() -> - try - begin match ParserEntry.parse_expr_string ctx.com.defines s p error inl with - | ParseSuccess(data,true,_) when inl -> data (* ignore errors when inline-parsing in display file *) - | ParseSuccess(data,_,_) -> data - | ParseError _ -> raise MacroApi.Invalid_expr - end - with Exit -> - raise MacroApi.Invalid_expr) + match ParserEntry.parse_expr_string ctx.com.defines s p error inl with + | ParseSuccess(data,true,_) when inl -> data (* ignore errors when inline-parsing in display file *) + | ParseSuccess(data,_,_) -> data + | ParseError _ -> raise MacroApi.Invalid_expr) in let parse_metadata s p = try - match ParserEntry.parse_string ctx.com.defines (s ^ " typedef T = T") null_pos error false with - | ParseSuccess((_,[ETypedef t,_]),_,_) -> t.d_meta + match ParserEntry.parse_string Grammar.parse_meta ctx.com.defines s null_pos error false with + | ParseSuccess(meta,_,_) -> meta | ParseError(_,_,_) -> error "Malformed metadata string" p - | _ -> die "" __LOC__ with _ -> error "Malformed metadata string" p in @@ -231,15 +226,14 @@ let make_macro_api ctx p = MacroApi.type_patch = (fun t f s v -> typing_timer ctx false (fun() -> let v = (match v with None -> None | Some s -> - match ParserEntry.parse_string ctx.com.defines ("typedef T = " ^ s) null_pos error false with - | ParseSuccess((_,[ETypedef { d_data = ct },_]),_,_) -> Some ct + match ParserEntry.parse_string Grammar.parse_complex_type ctx.com.defines s null_pos error false with + | ParseSuccess((ct,_),_,_) -> Some ct | ParseError(_,(msg,p),_) -> Parser.error msg p (* p is null_pos, but we don't have anything else here... *) - | _ -> die "" __LOC__ ) in let tp = get_type_patch ctx t (Some (f,s)) in match v with | None -> tp.tp_remove <- true - | Some _ -> tp.tp_type <- Option.map fst v + | Some t -> tp.tp_type <- Some t ); ); MacroApi.meta_patch = (fun m t f s p -> @@ -313,7 +307,7 @@ let make_macro_api ctx p = in let add is_macro ctx = let mdep = Option.map_default (fun s -> TypeloadModule.load_module ctx (parse_path s) pos) ctx.m.curmod mdep in - let mnew = TypeloadModule.type_module ctx ~dont_check_path:(has_native_meta) m mdep.m_extra.m_file [tdef,pos] pos in + let mnew = TypeloadModule.type_module ctx ~dont_check_path:(has_native_meta) m (Path.UniqueKey.lazy_path mdep.m_extra.m_file) [tdef,pos] pos in mnew.m_extra.m_kind <- if is_macro then MMacro else MFake; add_dependency mnew mdep; in @@ -342,7 +336,7 @@ let make_macro_api ctx p = let m = Hashtbl.find ctx.g.modules mpath in ignore(TypeloadModule.type_types_into_module ctx m types pos) with Not_found -> - let mnew = TypeloadModule.type_module ctx mpath ctx.m.curmod.m_extra.m_file types pos in + let mnew = TypeloadModule.type_module ctx mpath (Path.UniqueKey.lazy_path ctx.m.curmod.m_extra.m_file) types pos in mnew.m_extra.m_kind <- MFake; add_dependency mnew ctx.m.curmod; end @@ -421,10 +415,10 @@ and flush_macro_context mint ctx = mctx.com.Common.modules <- modules; (* we should maybe ensure that all filters in Main are applied. Not urgent atm *) let expr_filters = [ - VarLazifier.apply mctx.com; - AbstractCast.handle_abstract_casts mctx; - Exceptions.filter mctx; - CapturedVars.captured_vars mctx.com; + "VarLazifier",VarLazifier.apply mctx.com; + "handle_abstract_casts",AbstractCast.handle_abstract_casts mctx; + "Exceptions",Exceptions.filter mctx; + "captured_vars",CapturedVars.captured_vars mctx.com; ] in (* some filters here might cause side effects that would break compilation server. @@ -446,6 +440,7 @@ and flush_macro_context mint ctx = c.cl_restore <- (fun() -> c.cl_meta <- meta; c.cl_path <- path; + c.cl_descendants <- []; Option.may (fun fn -> fn()) ctor_restore; List.iter (fun fn -> fn()) field_restores; List.iter (fun fn -> fn()) static_restores; @@ -539,22 +534,32 @@ let load_macro_module ctx cpath display p = let load_macro' ctx display cpath f p = let api, mctx = get_macro_context ctx p in let mint = Interp.get_ctx() in - let mpath, sub = (match List.rev (fst cpath) with - | name :: pack when name.[0] >= 'A' && name.[0] <= 'Z' -> (List.rev pack,name), Some (snd cpath) - | _ -> cpath, None - ) in let (meth,mloaded) = try Hashtbl.find mctx.com.cached_macros (cpath,f) with Not_found -> let t = macro_timer ctx ["typing";s_type_path cpath ^ "." ^ f] in - let mloaded,restore = load_macro_module ctx mpath display p in - let mt = Typeload.load_type_def mctx p (mk_type_path ?sub mpath) in - let cl, meth = (match mt with - | TClassDecl c -> - mctx.g.do_finalize mctx; - c, (try PMap.find f c.cl_statics with Not_found -> error ("Method " ^ f ^ " not found on class " ^ s_type_path cpath) p) - | _ -> error "Macro should be called on a class" p + let mpath, sub = (match List.rev (fst cpath) with + | name :: pack when name.[0] >= 'A' && name.[0] <= 'Z' -> (List.rev pack,name), Some (snd cpath) + | _ -> cpath, None ) in + let mloaded,restore = load_macro_module ctx mpath display p in + let cl, meth = + try + if sub <> None then raise Not_found; + match mloaded.m_statics with + | None -> raise Not_found + | Some c -> + mctx.g.do_finalize mctx; + c, PMap.find f c.cl_statics + with Not_found -> + let name = Option.default (snd mpath) sub in + let path = fst mpath, name in + let mt = try List.find (fun t2 -> (t_infos t2).mt_path = path) mloaded.m_types with Not_found -> raise_error (Type_not_found (mloaded.m_path,name,Not_defined)) p in + match mt with + | TClassDecl c -> + mctx.g.do_finalize mctx; + c, (try PMap.find f c.cl_statics with Not_found -> error ("Method " ^ f ^ " not found on class " ^ s_type_path cpath) p) + | _ -> error "Macro should be called on a class" p + in api.MacroApi.current_macro_module <- (fun() -> mloaded); - DeprecationCheck.check_cf mctx.com meth p; let meth = (match follow meth.cf_type with TFun (args,ret) -> (args,ret,cl,meth),mloaded | _ -> error "Macro call should be a method" p) in restore(); if not ctx.in_macro then flush_macro_context mint ctx; @@ -595,6 +600,18 @@ type macro_arg_type = let type_macro ctx mode cpath f (el:Ast.expr list) p = let mctx, (margs,mret,mclass,mfield), call_macro = load_macro ctx (mode = MDisplay) cpath f p in + let margs = + (* + Replace "rest:haxe.Rest" in macro signatures with "rest:Array". + This allows to avoid handling special cases for rest args in macros during typing. + *) + match List.rev margs with + | (n,o,t) :: margs_rev -> + (match follow t with + | TAbstract ({ a_path = ["haxe"],"Rest" }, [t1]) -> List.rev ((n,o,mctx.t.tarray t1) :: margs_rev) + | _ -> margs) + | _ -> margs + in let mpos = mfield.cf_pos in let ctexpr = mk_type_path (["haxe";"macro"],"Expr") in let expr = Typeload.load_instance mctx (ctexpr,p) false in @@ -644,7 +661,6 @@ let type_macro ctx mode cpath f (el:Ast.expr list) p = | _ -> el,[] in - let todo = ref [] in let args = (* force default parameter types to haxe.macro.Expr, and if success allow to pass any value type since it will be encoded @@ -664,29 +680,24 @@ let type_macro ctx mode cpath f (el:Ast.expr list) p = let index = ref (-1) in let constants = List.map (fun e -> let p = snd e in - let e = (try - let e' = Texpr.type_constant_value ctx.com.basic e in - let rec loop e = match e with - | { eexpr = TConst (TString _); epos = p } when Lexer.is_fmt_string p -> - Lexer.remove_fmt_string p; - todo := (fun() -> Lexer.add_fmt_string p) :: !todo; - | _ -> Type.iter loop e - in - loop e'; - e - with Error (Custom _,_) -> - (* if it's not a constant, let's make something that is typed as haxe.macro.Expr - for nice error reporting *) - (EBlock [ - (EVars [("__tmp",null_pos),false,Some (CTPath ctexpr,p),Some (EConst (Ident "null"),p)],p); - (EConst (Ident "__tmp"),p); - ],p) - ) in + let e = + if Texpr.is_constant_value ctx.com.basic e then + (* temporarily disable format strings processing for macro call argument typing since we want to pass raw constants *) + let rec loop e = + match e with + | (EConst (String (s,SSingleQuotes)),p) -> (EConst (String (s,SDoubleQuotes)), p) + | _ -> Ast.map_expr loop e + in + loop e + else + (* if it's not a constant, let's make something that is typed as haxe.macro.Expr - for nice error reporting *) + (ECheckType ((EConst (Ident "null"),p), (CTPath ctexpr,p)), p) + in (* let's track the index by doing [e][index] (we will keep the expression type this way) *) incr index; (EArray ((EArrayDecl [e],p),(EConst (Int (string_of_int (!index))),p)),p) ) el in - let elt, _ = try Calls.unify_call_args mctx constants (List.map fst eargs) t_dynamic p false false with e -> List.iter (fun f -> f()) (!todo); raise e; in - List.iter (fun f -> f()) (!todo); + let elt = fst (CallUnification.unify_call_args mctx constants (List.map fst eargs) t_dynamic p false false false) in List.map2 (fun (_,mct) e -> let e, et = (match e.eexpr with (* get back our index and real expression *) @@ -730,12 +741,12 @@ let type_macro ctx mode cpath f (el:Ast.expr list) p = else List.map Interp.decode_field (Interp.decode_array v) in - Some (EVars [("fields",null_pos),false,Some (CTAnonymous fields,p),None],p) + Some (EVars [mk_evar ~t:(CTAnonymous fields,p) ("fields",null_pos)],p) ) | MMacroType -> "ComplexType",(fun () -> let t = if v = Interp.vnull then - mk_mono() + spawn_monomorph ctx p else try let ct = Interp.decode_ctype v in Typeload.load_complex_type ctx false ct; @@ -758,7 +769,7 @@ let type_macro ctx mode cpath f (el:Ast.expr list) p = let call_macro ctx path meth args p = let mctx, (margs,_,mclass,mfield), call = load_macro ctx false path meth p in mctx.curclass <- null_class; - let el, _ = Calls.unify_call_args mctx args margs t_dynamic p false false in + let el, _ = CallUnification.unify_call_args mctx args margs t_dynamic p false false false in call (List.map (fun e -> try Interp.make_const e with Exit -> error "Parameter should be a constant" e.epos) el) let call_init_macro ctx e = diff --git a/src/typing/magicTypes.ml b/src/typing/magicTypes.ml index f9c63060..c604f4fc 100644 --- a/src/typing/magicTypes.ml +++ b/src/typing/magicTypes.ml @@ -87,47 +87,6 @@ let extend_remoting ctx c t p async prot = | TClassDecl c2 when c2.cl_params = [] -> ignore(c2.cl_build()); c.cl_super <- Some (c2,[]); | _ -> error "Remoting proxy must be a class without parameters" p -(* -------------------------------------------------------------------------- *) -(* HAXE.XML.PROXY *) - -let extend_xml_proxy ctx c t file p = - let t = load_complex_type ctx false (t,p) in - let file = (try Common.find_file ctx.com file with Not_found -> file) in - add_dependency c.cl_module (create_fake_module ctx file); - let used = ref PMap.empty in - let print_results() = - PMap.iter (fun id used -> - if not used then ctx.com.warning (id ^ " is not used") p; - ) (!used) - in - let check_used = Common.defined ctx.com Define.CheckXmlProxy in - if check_used then ctx.g.hook_generate <- print_results :: ctx.g.hook_generate; - try - let rec loop = function - | Xml.Element (_,attrs,childs) -> - (try - let id = List.assoc "id" attrs in - if PMap.mem id c.cl_fields then error ("Duplicate id " ^ id) p; - let t = if not check_used then t else begin - used := PMap.add id false (!used); - let ft() = used := PMap.add id true (!used); t in - TLazy (ref (lazy_wait ft)) - end in - let f = { - (mk_field id t p null_pos) with - cf_kind = Var { v_read = AccResolve; v_write = AccNo }; - } in - c.cl_fields <- PMap.add id f c.cl_fields; - with - Not_found -> ()); - List.iter loop childs; - | Xml.PCData _ -> () - in - loop (Xml.parse_file file) - with - | Xml.Error e -> error ("XML error " ^ Xml.error e) p - | Xml.File_not_found f -> error ("XML File not found : " ^ f) p - let on_inherit ctx c p (is_extends,tp) = if not is_extends then true @@ -138,8 +97,5 @@ let on_inherit ctx c p (is_extends,tp) = | { tpackage = ["haxe";"remoting"]; tname = "AsyncProxy"; tparams = [TPType(CTPath t,null_pos)] } -> extend_remoting ctx c t p true true; false - | { tpackage = ["haxe";"xml"]; tname = "Proxy"; tparams = [TPExpr(EConst (String(file,SDoubleQuotes)),p);TPType (t,_)] } -> - extend_xml_proxy ctx c t file p; - true | _ -> true diff --git a/src/typing/matcher.ml b/src/typing/matcher.ml index f74e07a6..abb92a10 100644 --- a/src/typing/matcher.ml +++ b/src/typing/matcher.ml @@ -39,7 +39,7 @@ let make_offset_list left right middle other = (ExtList.List.make left other) @ [middle] @ (ExtList.List.make right other) let type_field_access ctx ?(resume=false) e name = - Calls.acc_get ctx (Fields.type_field (Fields.TypeFieldConfig.create resume) ctx e name e.epos MGet) e.epos + Calls.acc_get ctx (Fields.type_field (Fields.TypeFieldConfig.create resume) ctx e name e.epos MGet WithType.value) e.epos let unapply_type_parameters params monos = let unapplied = ref [] in @@ -176,7 +176,7 @@ module Pattern = struct let unify_type_pattern ctx mt t p = let tcl = get_general_module_type ctx mt p in match tcl with - | TAbstract(a,_) -> unify ctx (TAbstract(a,[mk_mono()])) t p + | TAbstract(a,_) -> unify ctx (TAbstract(a,[spawn_monomorph ctx p])) t p | _ -> die "" __LOC__ let rec make pctx toplevel t e = @@ -199,11 +199,12 @@ module Pattern = struct | Some map when not is_wildcard_local -> let v,p = try PMap.find name map with Not_found -> verror name p in unify ctx t v.v_type p; + if final then add_var_flag v VFinal; pctx.current_locals <- PMap.add name (v,p) pctx.current_locals; v | _ -> let v = alloc_var (VUser TVOPatternVariable) name t p in - if final then v.v_final <- true; + if final then add_var_flag v VFinal; pctx.current_locals <- PMap.add name (v,p) pctx.current_locals; ctx.locals <- PMap.add name v ctx.locals; v @@ -294,9 +295,9 @@ module Pattern = struct let sl = match follow t with | TEnum(en,_) -> en.e_names - | TAbstract({a_impl = Some c} as a,pl) when Meta.has Meta.Enum a.a_meta -> + | TAbstract({a_impl = Some c} as a,pl) when a.a_enum -> ExtList.List.filter_map (fun cf -> - if Meta.has Meta.Impl cf.cf_meta && Meta.has Meta.Enum cf.cf_meta then Some cf.cf_name else None + if has_class_field_flag cf CfImpl && has_class_field_flag cf CfEnum then Some cf.cf_name else None ) c.cl_ordered_statics | _ -> [] @@ -336,15 +337,16 @@ module Pattern = struct if i = "_" then PatAny else handle_ident i (pos e) end - | EVars([(s,p),final,None,None]) -> + | EVars([{ ev_name = (s,p); ev_final = final; ev_type = None; ev_expr = None; }]) -> let v = add_local final s p in PatVariable v | ECall(e1,el) -> let e1 = type_expr ctx e1 (WithType.with_type t) in begin match e1.eexpr,follow e1.etype with | TField(_, FEnum(en,ef)),TFun(_,TEnum(_,tl)) -> - let monos = List.map (fun _ -> mk_mono()) ef.ef_params in - let map t = apply_params en.e_params tl (apply_params ef.ef_params monos t) in + let map = apply_params en.e_params tl in + let monos = Monomorph.spawn_constrained_monos map ef.ef_params in + let map t = map (apply_params ef.ef_params monos t) in unify ctx (map ef.ef_type) e1.etype e1.epos; let args = match follow e1.etype with | TFun(args,r) -> @@ -408,43 +410,45 @@ module Pattern = struct in pattern t | EObjectDecl fl -> - let rec known_fields t = match follow t with + let known_fields = ref [] in + let collect_field cf t filter = match filter with + | Some sl when not (List.mem cf.cf_name sl) -> () + | _ -> known_fields := (cf,t) :: (List.filter (fun (cf',_) -> cf'.cf_name <> cf.cf_name) !known_fields) + in + let rec collect_fields t filter = match follow t with | TAnon an -> - PMap.fold (fun cf acc -> (cf,cf.cf_type) :: acc) an.a_fields [] + PMap.iter (fun _ cf -> collect_field cf cf.cf_type filter) an.a_fields | TInst(c,tl) -> - let rec loop fields c tl = - let fields = List.fold_left (fun acc cf -> - if Typecore.can_access ctx c cf false then (cf,apply_params c.cl_params tl cf.cf_type) :: acc - else acc - ) fields c.cl_ordered_fields in - match c.cl_super with - | None -> fields - | Some (csup,tlsup) -> loop fields csup (List.map (apply_params c.cl_params tl) tlsup) + let rec loop c tl = + (match c.cl_super with + | Some (csup,tlsup) -> loop csup (List.map (apply_params c.cl_params tl) tlsup) + | _ -> ()); + List.iter (fun cf -> + if Typecore.can_access ctx c cf false then + collect_field cf (apply_params c.cl_params tl cf.cf_type) filter + ) c.cl_ordered_fields in - loop [] c tl + loop c tl | TAbstract({a_impl = Some c} as a,tl) -> - let fields = try + (if Meta.has Meta.Forward a.a_meta then let _,el,_ = Meta.get Meta.Forward a.a_meta in let sl = ExtList.List.filter_map (fun e -> match fst e with | EConst(Ident s) -> Some s | _ -> None ) el in - let fields = known_fields (Abstract.get_underlying_type a tl) in - if sl = [] then fields else List.filter (fun (cf,t) -> List.mem cf.cf_name sl) fields - with Not_found -> - [] - in - let fields = List.fold_left (fun acc cf -> - if Meta.has Meta.Impl cf.cf_meta then - (cf,apply_params a.a_params tl cf.cf_type) :: acc - else - acc - ) fields c.cl_ordered_statics in - fields + let filter = if sl = [] then filter else Some (match filter with + | Some fsl -> List.filter (fun s -> List.mem s fsl) sl + | None -> sl + ) in + collect_fields (Abstract.get_underlying_type a tl) filter); + List.iter (fun cf -> + if has_class_field_flag cf CfImpl then + collect_field cf (apply_params a.a_params tl cf.cf_type) filter + ) c.cl_ordered_statics; | _ -> error (Printf.sprintf "Cannot field-match against %s" (s_type t)) (pos e) in - let known_fields = known_fields t in + collect_fields t None; let is_matchable cf = match cf.cf_kind with Method _ -> false | _ -> true in @@ -458,7 +462,7 @@ module Pattern = struct (PatAny,cf.cf_pos) :: patterns,cf.cf_name :: fields else patterns,fields - ) ([],[]) known_fields in + ) ([],[]) !known_fields in List.iter (fun ((s,_,_),e) -> if not (List.mem s fields) then error (Printf.sprintf "%s has no field %s" (s_type t) s) (pos e)) fl; PatConstructor(con_fields fields (pos e),patterns) | EBinop(OpOr,e1,e2) -> @@ -477,7 +481,7 @@ module Pattern = struct let v = add_local false s p in begin match dko with | None -> () - | Some dk -> ignore(TyperDisplay.display_expr ctx e (mk (TLocal v) v.v_type p) dk (WithType.with_type t) p); + | Some dk -> ignore(TyperDisplay.display_expr ctx e (mk (TLocal v) v.v_type p) dk (MSet None) (WithType.with_type t) p); end; let pat = make pctx false t e2 in PatBind(v,pat) @@ -506,18 +510,18 @@ module Pattern = struct let pat = loop e in let locals' = ctx.locals in ctx.locals <- locals; - ignore(TyperDisplay.handle_edisplay ctx e (display_mode()) (WithType.with_type t)); + ignore(TyperDisplay.handle_edisplay ctx e (display_mode()) MGet (WithType.with_type t)); ctx.locals <- locals'; pat (* For signature completion, we don't want to recurse into the inner pattern because there's probably a EDisplay(_,DMMarked) in there. We can handle display immediately because inner patterns should not matter (#7326) *) | EDisplay(e1,DKCall) -> - ignore(TyperDisplay.handle_edisplay ctx e (display_mode()) (WithType.with_type t)); + ignore(TyperDisplay.handle_edisplay ctx e (display_mode()) MGet (WithType.with_type t)); loop e1 | EDisplay(e,dk) -> let pat = loop e in - ignore(TyperDisplay.handle_edisplay ctx e (display_mode()) (WithType.with_type t)); + ignore(TyperDisplay.handle_edisplay ctx e (display_mode()) MGet (WithType.with_type t)); pat | EMeta((Meta.StoredTypedExpr,_,_),e1) -> let e1 = MacroContext.type_stored_expr ctx e1 in @@ -547,7 +551,7 @@ module Case = struct let e2 = collapse_case el in EBinop(OpOr,e,e2),punion (pos e) (pos e2) | [] -> - die "" __LOC__ + error "case without pattern" p in let e = collapse_case el in let monos = List.map (fun _ -> mk_mono()) ctx.type_params in @@ -768,8 +772,6 @@ module Useless = struct let rec loop acc pM = match pM with | patterns :: pM -> begin match patterns with - | ((PatConstructor _ | PatTuple _),_) :: _ -> - loop acc pM | ((PatVariable _ | PatAny),_) :: patterns -> loop (patterns :: acc) pM | _ -> @@ -827,7 +829,7 @@ module Useless = struct | ((PatVariable _ | PatAny),p) :: patterns2 -> let patterns1 = ExtList.List.make arity (PatAny,p) in loop ((patterns1 @ patterns2) :: pAcc) (q1 :: qAcc) (r1 :: rAcc) pM qM rM - | ((PatOr(pat1,pat2)),_) :: patterns2 -> + | (PatOr(pat1,pat2),_) :: patterns2 -> loop pAcc qAcc rAcc (((pat1 :: patterns2) :: (pat2 :: patterns2) :: pM)) (q1 :: q1 :: qM) (r1 :: r1 :: rM) | (PatBind(_,pat1),_) :: patterns2 -> loop2 (pat1 :: patterns2) @@ -959,7 +961,7 @@ module Compile = struct let rec get_sub_subjects mctx e con arg_positions = match fst con with | ConEnum(en,ef) -> - let tl = List.map (fun _ -> mk_mono()) en.e_params in + let tl = Monomorph.spawn_constrained_monos (fun t -> t) en.e_params in let t_en = TEnum(en,tl) in let e = if not (type_iseq t_en e.etype) then mk (TCast(e,None)) t_en e.epos else e in begin match follow ef.ef_type with @@ -993,69 +995,52 @@ module Compile = struct let specialize subject con cases = let arity = arity con in - let rec loop acc cases = match cases with - | (case,bindings,patterns) :: cases -> - begin match patterns with - | (PatConstructor(con',patterns1),_) :: patterns2 when Constructor.equal con con' -> - loop ((case,bindings,patterns1 @ patterns2) :: acc) cases - | (PatVariable v,p) :: patterns2 -> - let patterns1 = ExtList.List.make arity (PatAny,p) in - loop ((case,((v,p,subject) :: bindings),patterns1 @ patterns2) :: acc) cases - | ((PatAny,_)) as pat :: patterns2 -> - let patterns1 = ExtList.List.make arity pat in - loop ((case,bindings,patterns1 @ patterns2) :: acc) cases - | ((PatBind(v,pat),p)) :: patterns -> - loop acc ((case,((v,p,subject) :: bindings),pat :: patterns) :: cases) - | _ -> - loop acc cases - end - | [] -> - List.rev acc + let rec specialize (case,bindings,patterns) = match patterns with + | (PatConstructor(con',patterns1),_) :: patterns2 when Constructor.equal con con' -> + Some (case,bindings,patterns1 @ patterns2) + | (PatVariable v,p) :: patterns2 -> + Some (case,(v,p,subject) :: bindings,ExtList.List.make arity (PatAny,p) @ patterns2) + | (PatAny,_) as pat :: patterns2 -> + Some (case,bindings,ExtList.List.make arity pat @ patterns2) + | (PatBind(v,pat1),p) :: patterns -> + specialize (case,(v,p,subject) :: bindings,pat1 :: patterns) + | _ -> + None in - loop [] cases + ExtList.List.filter_map specialize cases let default subject cases = - let rec loop acc cases = match cases with - | (case,bindings,patterns) :: cases -> - begin match patterns with - | (PatConstructor _,_) :: _ -> - loop acc cases - | (PatVariable v,p) :: patterns -> - loop ((case,((v,p,subject) :: bindings),patterns) :: acc) cases - | (PatAny,_) :: patterns -> - loop ((case,bindings,patterns) :: acc) cases - | (PatBind(v,pat),p) :: patterns -> - loop acc ((case,((v,p,subject) :: bindings),pat :: patterns) :: cases) - | _ -> - loop acc cases - end - | [] -> - List.rev acc + let rec default (case,bindings,patterns) = match patterns with + | (PatVariable v,p) :: patterns -> + Some (case,((v,p,subject) :: bindings),patterns) + | (PatAny,_) :: patterns -> + Some (case,bindings,patterns) + | (PatBind(v,pat1),p) :: patterns -> + default (case,((v,p,subject) :: bindings),pat1 :: patterns) + | _ -> + None in - loop [] cases + ExtList.List.filter_map default cases let rec is_wildcard_pattern pat = match fst pat with | PatVariable _ | PatAny -> true + | PatBind(_,pat1) -> is_wildcard_pattern pat1 | _ -> false let rec expand cases = - let changed,cases = List.fold_left (fun (changed,acc) (case,bindings,patterns) -> - let rec loop f patterns = match patterns with - | (PatOr(pat1,pat2),_) :: patterns -> - true,(case,bindings,f pat2 :: patterns) :: (case,bindings,f pat1 :: patterns) :: acc - | (PatBind(v,pat1),p) :: patterns -> - loop (fun pat2 -> f (PatBind(v,pat2),p)) (pat1 :: patterns) - | (PatTuple patterns1,_) :: patterns2 -> - loop f (patterns1 @ patterns2) - | pat :: patterns -> - changed,(case,bindings,f pat :: patterns) :: acc - | [] -> - changed,((case,bindings,patterns) :: acc) - in - loop (fun pat -> pat) patterns - ) (false,[]) cases in - let cases = List.rev cases in - if changed then expand cases else cases + let rec expand f (case,bindings,patterns) = match patterns with + | (PatOr(pat1,pat2),_) :: patterns -> + (expand f (case,bindings,pat1 :: patterns)) @ (expand f (case,bindings,pat2 :: patterns)) + | (PatBind(v,pat1),p) :: patterns -> + expand (fun pat2 -> f (PatBind(v,pat2),p)) (case,bindings,pat1 :: patterns) + | (PatTuple patterns1,_) :: patterns2 -> + expand f (case,bindings,patterns1 @ patterns2) + | pat :: patterns -> + [(case,bindings,f pat :: patterns)] + | [] -> + [(case,bindings,patterns)] + in + List.flatten (List.map (expand (fun pat -> pat)) cases) let s_subjects subjects = String.concat " " (List.map s_expr_pretty subjects) @@ -1073,6 +1058,7 @@ module Compile = struct let select_column subjects cases = let rec loop i patterns = match patterns with | ((PatVariable _ | PatAny | PatExtractor _),_) :: patterns -> loop (i + 1) patterns + | (PatBind(_,pat1),_) :: patterns -> loop i (pat1 :: patterns) | [] -> 0 | _ -> i in @@ -1121,22 +1107,24 @@ module Compile = struct let dt2 = compile mctx subjects cases in guard mctx e dt dt2 in - let rec loop patterns el = match patterns,el with + let rec loop patterns el bindings = match patterns,el with | [PatAny,_],_ -> - [] + bindings | (PatVariable v,p) :: patterns,e :: el -> - (v,p,e) :: loop patterns el + loop patterns el ((v,p,e) :: bindings) + | (PatBind(v,pat1),p) :: patterns,e :: el -> + loop (pat1 :: patterns) (e :: el) ((v,p,e) :: bindings) | _ :: patterns,_ :: el -> - loop patterns el + loop patterns el bindings | [],[] -> - [] + bindings | [],e :: _ -> error "Invalid match: Not enough patterns" e.epos | (_,p) :: _,[] -> error "Invalid match: Too many patterns" p in - let bindings = bindings @ loop patterns subjects in - if bindings = [] then dt else bind mctx bindings dt + let bindings = loop patterns subjects bindings in + if bindings = [] then dt else bind mctx (List.rev bindings) dt and compile_switch mctx subjects cases = let subject,subjects = match subjects with @@ -1155,7 +1143,7 @@ module Compile = struct if case.case_guard = None then ConTable.replace unguarded con true; let arg_positions = snd (List.split patterns) in ConTable.replace sigma con arg_positions; - | PatBind(v,pat) -> loop ((v,pos pat,subject) :: bindings) pat + | PatBind(v,pat1) -> loop ((v,pos pat,subject) :: bindings) pat1 | PatVariable _ | PatAny -> () | PatExtractor _ -> raise Extractor | _ -> error ("Unexpected pattern: " ^ (Pattern.to_string pat)) case.case_pos; @@ -1205,20 +1193,20 @@ module Compile = struct let num_extractors,extractors = List.fold_left (fun (i,extractors) (_,_,patterns) -> let rec loop bindings pat = match pat with | (PatExtractor(v,e1,pat),_) -> i + 1,Some (v,e1,pat,bindings) :: extractors - | (PatBind(v,pat1),_) -> loop (v :: bindings) pat1 + | (PatBind(v,pat1),p) -> loop ((v,p,subject) :: bindings) pat1 | _ -> i,None :: extractors in loop [] (List.hd patterns) ) (0,[]) cases in let pat_any = (PatAny,null_pos) in let _,_,ex_subjects,cases,bindings = List.fold_left2 (fun (left,right,subjects,cases,ex_bindings) (case,bindings,patterns) extractor -> match extractor,patterns with - | Some(v,e1,pat,vars), _ :: patterns -> + | Some(v,e1,pat,bindings1), _ :: patterns -> let rec loop e = match e.eexpr with | TLocal v' when v' == v -> subject | _ -> Type.map_expr loop e in let e1 = loop e1 in - let bindings = List.map (fun v -> v,subject.epos,subject) vars @ bindings in + let bindings = bindings1 @ bindings in begin try let v,_,_,left2,right2 = List.find (fun (_,_,e2,_,_) -> Texpr.equal e1 e2) ex_bindings in let ev = mk (TLocal v) v.v_type e1.epos in @@ -1249,14 +1237,21 @@ module Compile = struct match_pos = p; dt_count = 0; } in - let subjects,vars = List.fold_left (fun (subjects,vars) e -> match e.eexpr with - | TConst _ | TLocal _ -> - (e :: subjects,vars) - | _ -> - let v = gen_local ctx e.etype e.epos in - let ev = mk (TLocal v) e.etype e.epos in - (ev :: subjects,(v,e.epos,e) :: vars) - ) ([],[]) subjects in + let rec loop (subjects,vars) el = match el with + | [] -> + List.rev subjects,List.rev vars + | e :: el -> + let subjects,vars = match e.eexpr with + | TConst _ | TLocal _ -> + (e :: subjects,vars) + | _ -> + let v = gen_local ctx e.etype e.epos in + let ev = mk (TLocal v) e.etype e.epos in + (ev :: subjects,(v,e.epos,e) :: vars) + in + loop (subjects,vars) el + in + let subjects,vars = loop ([],[]) subjects in begin match cases,subjects with | [],(subject :: _) -> let dt_fail = fail mctx subject.epos in @@ -1378,10 +1373,10 @@ module TexprConverter = struct add (ConConst(TBool true),null_pos); add (ConConst(TBool false),null_pos); SKValue,RunTimeFinite - | TAbstract({a_impl = Some c} as a,pl) when Meta.has Meta.Enum a.a_meta -> + | TAbstract({a_impl = Some c} as a,pl) when a.a_enum -> List.iter (fun cf -> ignore(follow cf.cf_type); - if Meta.has Meta.Impl cf.cf_meta && Meta.has Meta.Enum cf.cf_meta then match cf.cf_expr with + if has_class_field_flag cf CfImpl && has_class_field_flag cf CfEnum then match cf.cf_expr with | Some e -> begin match extract_const e with | Some ct -> if ct <> TNull then add (ConConst ct,null_pos) @@ -1422,7 +1417,7 @@ module TexprConverter = struct let report_not_exhaustive v_lookup e_subject unmatched = let sl = match follow e_subject.etype with - | TAbstract({a_impl = Some c} as a,tl) when Meta.has Meta.Enum a.a_meta -> + | TAbstract({a_impl = Some c} as a,tl) when a.a_enum -> List.map (fun (con,_) -> match fst con with | ConConst ct1 -> let cf = List.find (fun cf -> @@ -1586,7 +1581,7 @@ module TexprConverter = struct in f() | Bind(bl,dt) -> - let el = List.rev_map (fun (v,p,e) -> + let el = List.map (fun (v,p,e) -> v_lookup := IntMap.add v.v_id e !v_lookup; mk (TVar(v,Some e)) com.basic.tvoid p ) bl in @@ -1620,7 +1615,6 @@ module Match = struct e.etype,[e] in let t,subjects = loop e in - let subjects = List.rev subjects in let cases = match def with | None -> cases | Some (eo,p) -> cases @ [[EConst (Ident "_"),p],None,eo,p] @@ -1701,4 +1695,4 @@ module Match = struct type_expr ctx e WithType.value | _ -> match_expr ctx e cases def with_type postfix_match p -end \ No newline at end of file +end diff --git a/src/typing/nullSafety.ml b/src/typing/nullSafety.ml index 7fa2781e..0320b7dd 100644 --- a/src/typing/nullSafety.ml +++ b/src/typing/nullSafety.ml @@ -339,6 +339,7 @@ let rec unfold_null t = match t with | TMono r -> (match r.tm_type with None -> t | Some t -> unfold_null t) | TAbstract ({ a_path = ([],"Null") }, [t]) -> unfold_null t + | TAbstract (abstr,tl) when not (Meta.has Meta.CoreType abstr.a_meta) -> unfold_null (apply_params abstr.a_params tl abstr.a_this) | TLazy f -> unfold_null (lazy_type f) | TType (t,tl) -> unfold_null (apply_params t.t_params tl t.t_type) | _ -> t @@ -1073,6 +1074,7 @@ class expr_checker mode immediate_execution report = *) method can_pass_expr expr to_type p = match expr.eexpr, to_type with + | TLocal v, _ when contains_unsafe_meta v.v_meta -> true | TObjectDecl fields, TAnon to_type -> List.for_all (fun ((name, _, _), field_expr) -> @@ -1389,19 +1391,20 @@ class expr_checker mode immediate_execution report = | TNew (cls, params, args) -> let ctor = try - Some (get_constructor (fun ctor -> apply_params cls.cl_params params ctor.cf_type) cls) + Some (get_constructor cls) with | Not_found -> None in (match ctor with | None -> List.iter self#check_expr args - | Some (ctor_type, _) -> + | Some cf -> let rec traverse t = match follow t with | TFun (types, _) -> self#check_args e_new args types | _ -> fail ~msg:"Unexpected constructor type." e_new.epos __POS__ in + let ctor_type = apply_params cls.cl_params params cf.cf_type in traverse ctor_type ) | _ -> fail ~msg:"TNew expected" e_new.epos __POS__ @@ -1484,7 +1487,7 @@ class class_checker cls immediate_execution report = *) method check = validate_safety_meta report cls_meta; - if is_safe_class && (not cls.cl_extern) && (not cls.cl_interface) then + if is_safe_class && (not (has_class_flag cls CExtern)) && (not (has_class_flag cls CInterface)) then self#check_var_fields; let check_field is_static f = validate_safety_meta report f.cf_meta; diff --git a/src/typing/operators.ml b/src/typing/operators.ml new file mode 100644 index 00000000..f4ed190f --- /dev/null +++ b/src/typing/operators.ml @@ -0,0 +1,942 @@ +open Globals +open Ast +open Type +open TyperBase +open Typecore +open Error +open CallUnification +open Calls +open Fields +open FieldAccess + +class value_reference (ctx : typer) = + +object(self) + val vars = DynArray.create () + + method get_vars = DynArray.to_list vars + + method as_var name e = + let v = alloc_var VGenerated name e.etype e.epos in + DynArray.add vars (v,e); + mk (TLocal v) v.v_type v.v_pos + + method private get_expr_aux depth name e = + let rec loop depth name e = match (Texpr.skip e).eexpr with + | TLocal _ | TTypeExpr _ | TConst _ -> + e + | TField(ef,fa) when depth = 0 -> + let ef = loop (depth + 1) "fh" ef in + {e with eexpr = TField(ef,fa)} + | TArray(e1,e2) when depth = 0 -> + let e1 = loop (depth + 1) "base" e1 in + let e2 = loop (depth + 1) "index" e2 in + {e with eexpr = TArray(e1,e2)} + | _ -> + self#as_var name e + in + loop depth name e + + method get_expr name e = + self#get_expr_aux 0 name e + + method get_expr_part name e = + self#get_expr_aux 1 name e + + method to_texpr e = + begin match self#get_vars with + | [] -> + e + | vl -> + let el = List.map (fun (v,e) -> + mk (TVar(v,Some e)) ctx.t.tvoid v.v_pos + ) vl in + let e = mk (TBlock (el @ [e])) e.etype e.epos in + {e with eexpr = TMeta((Meta.MergeBlock,[],null_pos),e)} + end + + method to_texpr_el el e = + let vl = self#get_vars in + let el_vars = List.map (fun (v,e) -> + mk (TVar(v,Some e)) ctx.t.tvoid v.v_pos + ) vl in + let e = mk (TBlock (el_vars @ el @ [e])) e.etype e.epos in + {e with eexpr = TMeta((Meta.MergeBlock,[],null_pos),e)} +end + +module BinopResult = struct + + type normal_binop = { + binop_op : binop; + binop_lhs : texpr; + binop_rhs : texpr; + binop_type : Type.t; + binop_needs_assign : bool; + binop_swapped : bool; + binop_pos : pos; + } + + type t = + | BinopNormal of normal_binop + | BinopSpecial of texpr * bool + + let to_string br = + let st = s_type (print_context()) in + let se = s_expr_pretty false "" false st in + match br with + | BinopNormal bn -> + Printer.s_record_fields "" [ + "binop_op",s_binop bn.binop_op; + "binop_lhs",se bn.binop_lhs; + "binop_rhs",se bn.binop_rhs; + "binop_type",st bn.binop_type; + "binop_needs_assign",string_of_bool bn.binop_needs_assign; + "binop_swapped",string_of_bool bn.binop_swapped; + "binop_pos",Printer.s_pos bn.binop_pos; + ] + | BinopSpecial(e,needs_assign) -> + Printf.sprintf "BinopSpecial(%s,%b)" (se e) needs_assign + + let create_normal op e1 e2 t needs_assign swapped p = + BinopNormal { + binop_op = op; + binop_lhs = e1; + binop_rhs = e2; + binop_type = t; + binop_needs_assign = needs_assign; + binop_swapped = swapped; + binop_pos = p; + } + + let create_special e needs_assign = + BinopSpecial(e,needs_assign) + + let to_texpr vr br assign = match br with + | BinopNormal bn -> + let e1 = bn.binop_lhs in + let e2 = bn.binop_rhs in + let e1,e2 = match bn.binop_swapped with + | false -> + e1,e2 + | true -> + let eloc1 = vr#as_var "lhs" e2 in + let eloc2 = vr#as_var "rhs" e1 in + eloc2,eloc1 + in + let e = mk (TBinop(bn.binop_op,e1,e2)) bn.binop_type bn.binop_pos in + if bn.binop_needs_assign then assign e else e + | BinopSpecial(e,needs_assign) -> + if needs_assign then assign e else e + + let get_type br = match br with + | BinopNormal bn -> bn.binop_type + | BinopSpecial(e,_) -> e.etype +end + +let check_assign ctx e = + if ctx.com.display.dms_error_policy <> EPIgnore then match e.eexpr with + | TLocal v when has_var_flag v VFinal -> + error "Cannot assign to final" e.epos + | TLocal {v_extra = None} | TArray _ | TField _ | TIdent _ -> + () + | TConst TThis | TTypeExpr _ when ctx.untyped -> + () + | _ -> + invalid_assign e.epos + +type type_class = + | KInt + | KFloat + | KString + | KUnk + | KDyn + | KOther + | KNumParam of t + | KStrParam of t + | KAbstract of tabstract * t list + +let rec classify t = + match follow t with + | TInst ({ cl_path = ([],"String") },[]) -> KString + | TAbstract({a_impl = Some _} as a,tl) -> KAbstract (a,tl) + | TAbstract ({ a_path = [],"Int" },[]) -> KInt + | TAbstract ({ a_path = [],"Float" },[]) -> KFloat + | TAbstract (a,[]) when List.exists (fun t -> match classify t with KInt | KFloat -> true | _ -> false) a.a_to -> KNumParam t + | TInst ({ cl_kind = KTypeParameter ctl },_) when List.exists (fun t -> match classify t with KInt | KFloat -> true | _ -> false) ctl -> KNumParam t + | TAbstract (a,[]) when List.exists (fun t -> match classify t with KString -> true | _ -> false) a.a_to -> KStrParam t + | TInst ({ cl_kind = KTypeParameter ctl },_) when List.exists (fun t -> match classify t with KString -> true | _ -> false) ctl -> KStrParam t + | TMono r when r.tm_type = None -> KUnk + | TDynamic _ -> KDyn + | _ -> KOther + +(* + We want to try unifying as an integer and apply side effects. + However, in case the value is not a normal Monomorph but one issued + from a Dynamic relaxation, we will instead unify with float since + we don't want to accidentaly truncate the value +*) +let unify_int ctx e k = + let is_dynamic t = + match follow t with + | TDynamic _ -> true + | _ -> false + in + let is_dynamic_array t = + match follow t with + | TInst (_,[p]) -> is_dynamic p + | _ -> true + in + let is_dynamic_field t f = + match follow t with + | TAnon a -> + (try is_dynamic (PMap.find f a.a_fields).cf_type with Not_found -> false) + | TMono m -> + begin match Monomorph.classify_constraints m with + | CStructural(fields,_) -> + (try is_dynamic (PMap.find f fields).cf_type with Not_found -> false) + | _ -> + true + end + | TInst (c,tl) -> + (try is_dynamic (apply_params c.cl_params tl ((let _,t,_ = Type.class_field c tl f in t))) with Not_found -> false) + | _ -> + true + in + let is_dynamic_return t = + match follow t with + | TFun (_,r) -> is_dynamic r + | _ -> true + in + (* + This is some quick analysis that matches the most common cases of dynamic-to-mono convertions + *) + let rec maybe_dynamic_mono e = + match e.eexpr with + | TLocal _ -> is_dynamic e.etype + | TArray({ etype = t } as e,_) -> is_dynamic_array t || maybe_dynamic_rec e t + | TField({ etype = t } as e,f) -> is_dynamic_field t (field_name f) || maybe_dynamic_rec e t + | TCall({ etype = t } as e,_) -> is_dynamic_return t || maybe_dynamic_rec e t + | TParenthesis e | TMeta(_,e) -> maybe_dynamic_mono e + | TIf (_,a,Some b) -> maybe_dynamic_mono a || maybe_dynamic_mono b + | _ -> false + and maybe_dynamic_rec e t = + match follow t with + | TMono _ | TDynamic _ -> maybe_dynamic_mono e + (* we might have inferenced a tmono into a single field *) + (* TODO: check what this did exactly *) + (* | TAnon a when !(a.a_status) = Opened -> maybe_dynamic_mono e *) + | _ -> false + in + match k with + | KUnk | KDyn when maybe_dynamic_mono e -> + unify ctx e.etype ctx.t.tfloat e.epos; + false + | _ -> + unify ctx e.etype ctx.t.tint e.epos; + true + +let make_binop ctx op e1 e2 is_assign_op with_type p = + let tint = ctx.t.tint in + let tfloat = ctx.t.tfloat in + let tstring = ctx.t.tstring in + let to_string e = + let rec loop t = match classify t with + | KAbstract ({a_impl = Some c},_) when PMap.mem "toString" c.cl_statics -> + call_to_string ctx e + | KInt | KFloat | KString -> e + | KUnk | KDyn | KNumParam _ | KStrParam _ | KOther -> + let std = type_type ctx ([],"Std") e.epos in + let acc = acc_get ctx (type_field_default_cfg ctx std "string" e.epos (MCall []) with_type) e.epos in + ignore(follow acc.etype); + let acc = (match acc.eexpr with TField (e,FClosure (Some (c,tl),f)) -> { acc with eexpr = TField (e,FInstance (c,tl,f)) } | _ -> acc) in + make_call ctx acc [e] ctx.t.tstring e.epos + | KAbstract (a,tl) -> + try + AbstractCast.cast_or_unify_raise ctx tstring e p + with Error (Unify _,_) -> + loop (Abstract.get_underlying_type a tl) + in + loop e.etype + in + let mk_op e1 e2 t = + let e1,e2 = if op = OpAdd && (classify t) = KString then + let e1 = to_string e1 in + let e2 = to_string e2 in + e1,e2 + else + e1,e2 + in + BinopResult.create_normal op e1 e2 t is_assign_op false p + in + match op with + | OpAdd -> + mk_op e1 e2 (match classify e1.etype, classify e2.etype with + | KInt , KInt -> + tint + | KFloat , KInt + | KInt, KFloat + | KFloat, KFloat -> + tfloat + | KUnk , KInt -> + if unify_int ctx e1 KUnk then tint else tfloat + | KUnk , KFloat + | KUnk , KString -> + unify ctx e1.etype e2.etype e1.epos; + e1.etype + | KInt , KUnk -> + if unify_int ctx e2 KUnk then tint else tfloat + | KFloat , KUnk + | KString , KUnk -> + unify ctx e2.etype e1.etype e2.epos; + e2.etype + | _ , KString + | KString , _ -> + tstring + | _ , KDyn -> + e2.etype + | KDyn , _ -> + e1.etype + | KUnk , KUnk -> + let ok1 = unify_int ctx e1 KUnk in + let ok2 = unify_int ctx e2 KUnk in + if ok1 && ok2 then tint else tfloat + | KNumParam t1, KNumParam t2 when Type.type_iseq t1 t2 -> + t1 + | KNumParam t, KInt | KInt, KNumParam t -> + t + | KNumParam _, KFloat | KFloat, KNumParam _ | KNumParam _, KNumParam _ -> + tfloat + | KNumParam t, KUnk -> + unify ctx e2.etype tfloat e2.epos; + tfloat + | KUnk, KNumParam t -> + unify ctx e1.etype tfloat e1.epos; + tfloat + | KStrParam _, _ + | _, KStrParam _ -> + tstring + | KAbstract _,KFloat -> + unify ctx e1.etype tfloat e1.epos; + tfloat + | KFloat, KAbstract _ -> + unify ctx e2.etype tfloat e2.epos; + tfloat + | KAbstract _,KInt -> + unify ctx e1.etype ctx.t.tint e1.epos; + ctx.t.tint + | KInt, KAbstract _ -> + unify ctx e2.etype ctx.t.tint e2.epos; + ctx.t.tint + | KAbstract _,_ + | _,KAbstract _ + | KNumParam _, _ + | _, KNumParam _ + | KOther, _ + | _ , KOther -> + let pr = print_context() in + error ("Cannot add " ^ s_type pr e1.etype ^ " and " ^ s_type pr e2.etype) p + ) + | OpAnd + | OpOr + | OpXor + | OpShl + | OpShr + | OpUShr -> + let i = tint in + unify ctx e1.etype i e1.epos; + unify ctx e2.etype i e2.epos; + mk_op e1 e2 i + | OpMod + | OpMult + | OpDiv + | OpSub -> + let result = ref (if op = OpDiv then tfloat else tint) in + (match classify e1.etype, classify e2.etype with + | KFloat, KFloat -> + result := tfloat + | KNumParam t1, KNumParam t2 when Type.type_iseq t1 t2 -> + if op <> OpDiv then result := t1 + | KNumParam _, KNumParam _ -> + result := tfloat + | KNumParam t, KInt | KInt, KNumParam t -> + if op <> OpDiv then result := t + | KNumParam _, KFloat | KFloat, KNumParam _ -> + result := tfloat + | KFloat, k -> + ignore(unify_int ctx e2 k); + result := tfloat + | k, KFloat -> + ignore(unify_int ctx e1 k); + result := tfloat + | k1 , k2 -> + let ok1 = unify_int ctx e1 k1 in + let ok2 = unify_int ctx e2 k2 in + if not ok1 || not ok2 then result := tfloat; + ); + mk_op e1 e2 !result + | OpEq + | OpNotEq -> + let e1,e2 = try + (* we only have to check one type here, because unification fails if one is Void and the other is not *) + (match follow e2.etype with TAbstract({a_path=[],"Void"},_) -> error "Cannot compare Void" p | _ -> ()); + AbstractCast.cast_or_unify_raise ctx e2.etype e1 p,e2 + with Error (Unify _,_) -> + e1,AbstractCast.cast_or_unify ctx e1.etype e2 p + in + if not ctx.com.config.pf_supports_function_equality then begin match e1.eexpr, e2.eexpr with + | TConst TNull , _ | _ , TConst TNull -> () + | _ -> + match follow e1.etype, follow e2.etype with + | TFun _ , _ | _, TFun _ -> ctx.com.warning "Comparison of function values is unspecified on this target, use Reflect.compareMethods instead" p + | _ -> () + end; + mk_op e1 e2 ctx.t.tbool + | OpGt + | OpGte + | OpLt + | OpLte -> + (match classify e1.etype, classify e2.etype with + | KInt , KInt | KInt , KFloat | KFloat , KInt | KFloat , KFloat | KString , KString -> () + | KInt , KUnk -> ignore(unify_int ctx e2 KUnk) + | KFloat , KUnk | KString , KUnk -> unify ctx e2.etype e1.etype e2.epos + | KUnk , KInt -> ignore(unify_int ctx e1 KUnk) + | KUnk , KFloat | KUnk , KString -> unify ctx e1.etype e2.etype e1.epos + | KUnk , KUnk -> + ignore(unify_int ctx e1 KUnk); + ignore(unify_int ctx e2 KUnk); + | KDyn , KInt | KDyn , KFloat | KDyn , KString -> () + | KInt , KDyn | KFloat , KDyn | KString , KDyn -> () + | KDyn , KDyn -> () + | KNumParam _ , (KInt | KFloat | KNumParam _ | KDyn | KUnk ) -> () + | (KInt | KFloat | KDyn | KUnk ), KNumParam _ -> () + | KStrParam _ , (KString | KStrParam _ | KUnk | KDyn) -> () + | (KString | KUnk | KDyn) , KStrParam _ -> () + | KAbstract _,_ + | _,KAbstract _ + | KDyn , KUnk + | KUnk , KDyn + | KString , KInt + | KString , KFloat + | KInt , KString + | KFloat , KString + | KNumParam _ , _ + | _ , KNumParam _ + | KStrParam _ , _ + | _ , KStrParam _ + | KOther , _ + | _ , KOther -> + let pr = print_context() in + error ("Cannot compare " ^ s_type pr e1.etype ^ " and " ^ s_type pr e2.etype) p + ); + mk_op e1 e2 ctx.t.tbool + | OpBoolAnd + | OpBoolOr -> + let b = ctx.t.tbool in + unify ctx e1.etype b p; + unify ctx e2.etype b p; + mk_op e1 e2 b + | OpInterval -> + let t = Typeload.load_core_type ctx "IntIterator" in + unify ctx e1.etype tint e1.epos; + unify ctx e2.etype tint e2.epos; + BinopSpecial (mk (TNew ((match t with TInst (c,[]) -> c | _ -> die "" __LOC__),[],[e1;e2])) t p,false) + | OpArrow -> + error "Unexpected =>" p + | OpIn -> + error "Unexpected in" p + | OpAssign + | OpAssignOp _ -> + die "" __LOC__ + +let find_abstract_binop_overload ctx op e1 e2 a c tl left is_assign_op with_type p = + let map = apply_params a.a_params tl in + let make op_cf cf e1 e2 tret needs_assign swapped = + if cf.cf_expr = None && not (has_class_field_flag cf CfExtern) then begin + if not (Meta.has Meta.NoExpr cf.cf_meta) then display_error ctx "Recursive operator method" p; + if not (Meta.has Meta.CoreType a.a_meta) then begin + (* for non core-types we require that the return type is compatible to the native result type *) + let result = make_binop ctx op {e1 with etype = Abstract.follow_with_abstracts e1.etype} {e1 with etype = Abstract.follow_with_abstracts e2.etype} is_assign_op with_type p in + let t_expected = BinopResult.get_type result in + begin try + unify_raise ctx tret t_expected p + with Error (Unify _,_) -> + match follow tret with + | TAbstract(a,tl) when type_iseq (Abstract.get_underlying_type a tl) t_expected -> + () + | _ -> + let st = s_type (print_context()) in + error (Printf.sprintf "The result of this operation (%s) is not compatible with declared return type %s" (st t_expected) (st tret)) p + end; + end; + BinopResult.create_normal op e1 e2 tret needs_assign swapped p + end else if swapped then begin + let vr = new value_reference ctx in + let e2' = vr#as_var "lhs" e2 in + let e1' = vr#as_var "rhs" e1 in + let e = make_static_call ctx c cf map [e1';e2'] tret p in + let e = vr#to_texpr e in + BinopResult.create_special e needs_assign + end else + BinopResult.create_special (make_static_call ctx c cf map [e1;e2] tret p) needs_assign + in + (* special case for == and !=: if the second type is a monomorph, assume that we want to unify + it with the first type to preserve comparison semantics. *) + let is_eq_op = match op with OpEq | OpNotEq -> true | _ -> false in + if is_eq_op then begin match follow e1.etype,follow e2.etype with + | TMono _,_ | _,TMono _ -> + Type.unify e1.etype e2.etype + | _ -> + () + end; + let rec loop find_op ol = match ol with + | (op_cf,cf) :: ol when op_cf = find_op -> + let is_impl = has_class_field_flag cf CfImpl in + begin match follow cf.cf_type with + | TFun([(_,_,t1);(_,_,t2)],tret) -> + let check e1 e2 swapped = + let map_arguments () = + let monos = Monomorph.spawn_constrained_monos (fun t -> t) cf.cf_params in + let map t = map (apply_params cf.cf_params monos t) in + let t1 = map t1 in + let t2 = map t2 in + let tret = map tret in + monos,t1,t2,tret + in + let monos,t1,t2,tret = map_arguments() in + let make e1 e2 = make op_cf cf e1 e2 tret in + let t1 = if is_impl then Abstract.follow_with_abstracts t1 else t1 in + let e1,e2 = if left || not left && swapped then begin + Type.type_eq EqStrict (if is_impl then Abstract.follow_with_abstracts e1.etype else e1.etype) t1; + e1,AbstractCast.cast_or_unify_raise ctx t2 e2 p + end else begin + Type.type_eq EqStrict e2.etype t2; + AbstractCast.cast_or_unify_raise ctx t1 e1 p,e2 + end in + let check_null e t = if is_eq_op then match e.eexpr with + | TConst TNull when not (is_explicit_null t) -> raise (Unify_error []) + | _ -> () + in + (* If either expression is `null` we only allow operator resolving if the argument type + is explicitly Null (issue #3376) *) + if is_eq_op then begin + check_null e2 t2; + check_null e1 t1; + end; + let needs_assign = is_assign_op && op_cf = op in + make e1 e2 needs_assign swapped + in + begin try + check e1 e2 false + with Error (Unify _,_) | Unify_error _ -> try + if not (Meta.has Meta.Commutative cf.cf_meta) then raise Not_found; + check e2 e1 true + with Not_found | Error (Unify _,_) | Unify_error _ -> + loop find_op ol + end + | _ -> + die "" __LOC__ + end + | [] -> + raise Not_found + | _ :: ol -> + loop find_op ol + in + let find loop = + if left then + loop a.a_ops + else + let not_impl_or_is_commutative (_, cf) = + not (has_class_field_flag cf CfImpl) || Meta.has Meta.Commutative cf.cf_meta + in + loop (List.filter not_impl_or_is_commutative a.a_ops) + in + if is_assign_op then + try find (loop (OpAssignOp op)) + with Not_found -> find (loop op) + else + find (loop op) + +let try_abstract_binop_overloads ctx op e1 e2 is_assign_op with_type p = + try + begin match follow e1.etype with + | TAbstract({a_impl = Some c} as a,tl) -> find_abstract_binop_overload ctx op e1 e2 a c tl true is_assign_op with_type p + | _ -> raise Not_found + end + with Not_found -> + begin match follow e2.etype with + | TAbstract({a_impl = Some c} as a,tl) -> find_abstract_binop_overload ctx op e1 e2 a c tl false is_assign_op with_type p + | _ -> raise Not_found + end + +let type_binop_rhs ctx op (e1 : texpr) (e2 : Ast.expr) is_assign_op wt p = + let with_type = match op with + | OpEq | OpNotEq | OpLt | OpLte | OpGt | OpGte -> WithType.with_type e1.etype + | _ -> wt + in + type_expr ctx e2 with_type,with_type + +let type_binop2 ctx op (e1 : texpr) (e2 : Ast.expr) is_assign_op with_type p = + let e2,with_type = type_binop_rhs ctx op e1 e2 is_assign_op with_type p in + try + try_abstract_binop_overloads ctx op e1 e2 is_assign_op with_type p + with Not_found -> + make_binop ctx op e1 e2 is_assign_op with_type p + +let type_assign ctx e1 e2 with_type p = + let e1 = !type_access_ref ctx (fst e1) (snd e1) (MSet (Some e2)) with_type in + let type_rhs with_type = type_expr ctx e2 with_type in + let assign_to e1 = + let e2 = type_rhs (WithType.with_type e1.etype) in + let e2 = AbstractCast.cast_or_unify ctx e1.etype e2 p in + check_assign ctx e1; + (match e1.eexpr , e2.eexpr with + | TLocal i1 , TLocal i2 when i1 == i2 -> error "Assigning a value to itself" p + | TField ({ eexpr = TConst TThis },FInstance (_,_,f1)) , TField ({ eexpr = TConst TThis },FInstance (_,_,f2)) when f1 == f2 -> + error "Assigning a value to itself" p + | _ , _ -> ()); + mk (TBinop (OpAssign,e1,e2)) e1.etype p + in + match e1 with + | AKNo s -> error ("Cannot access field or identifier " ^ s ^ " for writing") p + | AKUsingField _ -> + error "Invalid operation" p + | AKExpr { eexpr = TLocal { v_kind = VUser TVOLocalFunction; v_name = name } } -> + error ("Cannot access function " ^ name ^ " for writing") p + | AKField fa -> + let ef = FieldAccess.get_field_expr fa FWrite in + assign_to ef + | AKExpr e1 -> + assign_to e1 + | AKAccessor fa -> + let dispatcher = new call_dispatcher ctx (MSet (Some e2)) with_type p in + dispatcher#accessor_call fa [] [e2] + | AKAccess(a,tl,c,ebase,ekey) -> + let e2 = type_rhs WithType.value in + mk_array_set_call ctx (AbstractCast.find_array_access ctx a tl ekey (Some e2) p) c ebase p + | AKResolve(sea,name) -> + let eparam = sea.se_this in + let e_name = Texpr.Builder.make_string ctx.t name null_pos in + (new call_dispatcher ctx (MCall [e2]) with_type p)#field_call sea.se_access [eparam;e_name] [e2] + | AKUsingAccessor sea -> + let fa_set = match FieldAccess.resolve_accessor sea.se_access (MSet (Some e2)) with + | AccessorFound fa -> fa + | _ -> error "Could not resolve accessor" p + in + let dispatcher = new call_dispatcher ctx (MCall [e2]) with_type p in + dispatcher#field_call fa_set [sea.se_this] [e2] + +let type_non_assign_op ctx op e1 e2 is_assign_op abstract_overload_only with_type p = + (* If the with_type is an abstract which has exactly one applicable @:op method, we can promote it + to the individual arguments (issue #2786). *) + let wt = match with_type with + | WithType.WithType(t,_) -> + begin match follow t with + | TAbstract(a,_) -> + begin match List.filter (fun (o,_) -> o = OpAssignOp(op) || o == op) a.a_ops with + | [_] -> with_type + | _ -> WithType.value + end + | _ -> + WithType.value + end + | _ -> + WithType.value + in + let e1 = type_expr ctx e1 wt in + let result = if abstract_overload_only then begin + let e2,with_type = type_binop_rhs ctx op e1 e2 is_assign_op with_type p in + try_abstract_binop_overloads ctx op e1 e2 is_assign_op with_type p + end else + type_binop2 ctx op e1 e2 is_assign_op wt p + in + let vr = new value_reference ctx in + let e = BinopResult.to_texpr vr result (fun _ -> raise Not_found) in + vr#to_texpr e + +let process_lhs_expr ctx name e_lhs = + let vr = new value_reference ctx in + let e = vr#get_expr name e_lhs in + e,vr + +let type_assign_op ctx op e1 e2 with_type p = + let field_rhs_by_name op name ev with_type = + let access_get = type_field_default_cfg ctx ev name p MGet with_type in + let e_get = acc_get ctx access_get p in + e_get.etype,type_binop2 ctx op e_get e2 true (WithType.with_type e_get.etype) p + in + let field_rhs op cf ev = + field_rhs_by_name op cf.cf_name ev (WithType.with_type cf.cf_type) + in + let assign vr e r_rhs = + let assign e_rhs = + let e_rhs = AbstractCast.cast_or_unify ctx e.etype e_rhs p in + match e_rhs.eexpr with + | TBinop(op',e1',e2') when op = op' && Texpr.equal e e1' -> + mk (TBinop(OpAssignOp op',e1',e2')) e.etype p + | _ -> + mk (TBinop(OpAssign,e,e_rhs)) e.etype p + in + let e = BinopResult.to_texpr vr r_rhs assign in + vr#to_texpr e + in + let set vr fa t_lhs r_rhs el = + let assign e_rhs = + let e_rhs = AbstractCast.cast_or_unify ctx t_lhs e_rhs p in + let dispatcher = new call_dispatcher ctx (MSet (Some e2)) with_type p in + dispatcher#accessor_call fa (el @ [e_rhs]) []; + in + let e = BinopResult.to_texpr vr r_rhs assign in + vr#to_texpr e + in + (match !type_access_ref ctx (fst e1) (snd e1) (MSet (Some e2)) with_type with + | AKNo s -> + (* try abstract operator overloading *) + (try type_non_assign_op ctx op e1 e2 true true with_type p + with Not_found -> error ("Cannot access field or identifier " ^ s ^ " for writing") p + ) + | AKUsingField _ -> + error "Invalid operation" p + | AKExpr e -> + let e,vr = process_lhs_expr ctx "lhs" e in + let e_rhs = type_binop2 ctx op e e2 true (WithType.with_type e.etype) p in + assign vr e e_rhs + | AKField fa -> + let vr = new value_reference ctx in + let ef = vr#get_expr_part "fh" fa.fa_on in + let _,e_rhs = field_rhs op fa.fa_field ef in + let e_lhs = FieldAccess.get_field_expr {fa with fa_on = ef} FWrite in + assign vr e_lhs e_rhs + | AKAccessor fa -> + let vr = new value_reference ctx in + let ef = vr#get_expr_part "fh" fa.fa_on in + let t_lhs,e_rhs = field_rhs op fa.fa_field ef in + set vr {fa with fa_on = ef} t_lhs e_rhs [] + | AKUsingAccessor sea -> + let fa = sea.se_access in + let ef,vr = process_lhs_expr ctx "fh" sea.se_this in + let t_lhs,e_rhs = field_rhs op fa.fa_field ef in + set vr sea.se_access t_lhs e_rhs [ef] + | AKAccess(a,tl,c,ebase,ekey) -> + let cf_get,tf_get,r_get,ekey,_ = AbstractCast.find_array_access ctx a tl ekey None p in + (* bind complex keys to a variable so they do not make it into the output twice *) + let save = save_locals ctx in + let maybe_bind_to_temp e = match Optimizer.make_constant_expression ctx e with + | Some e -> e,None + | None -> + let v = gen_local ctx e.etype p in + let e' = mk (TLocal v) e.etype p in + e', Some (mk (TVar (v,Some e)) ctx.t.tvoid p) + in + let ekey,ekey' = maybe_bind_to_temp ekey in + let ebase,ebase' = maybe_bind_to_temp ebase in + let eget = mk_array_get_call ctx (cf_get,tf_get,r_get,ekey,None) c ebase p in + let eget = type_binop2 ctx op eget e2 true (WithType.with_type eget.etype) p in + let vr = new value_reference ctx in + let eget = BinopResult.to_texpr vr eget (fun e -> e) in + unify ctx eget.etype r_get p; + let cf_set,tf_set,r_set,ekey,eget = AbstractCast.find_array_access ctx a tl ekey (Some eget) p in + let eget = match eget with None -> die "" __LOC__ | Some e -> e in + let et = type_module_type ctx (TClassDecl c) None p in + let e = match cf_set.cf_expr,cf_get.cf_expr with + | None,None -> + let ea = mk (TArray(ebase,ekey)) r_get p in + mk (TBinop(OpAssignOp op,ea,type_expr ctx e2 (WithType.with_type r_get))) r_set p + | Some _,Some _ -> + let ef_set = mk (TField(et,(FStatic(c,cf_set)))) tf_set p in + let el = [make_call ctx ef_set [ebase;ekey;eget] r_set p] in + let el = match ebase' with None -> el | Some ebase -> ebase :: el in + let el = match ekey' with None -> el | Some ekey -> ekey :: el in + begin match el with + | [e] -> e + | el -> mk (TBlock el) r_set p + end + | _ -> + error "Invalid array access getter/setter combination" p + in + save(); + vr#to_texpr e + | AKResolve(sea,name) -> + let e,vr = process_lhs_expr ctx "fh" sea.se_this in + let t_lhs,r_rhs = field_rhs_by_name op name e WithType.value in + let assign e_rhs = + let e_name = Texpr.Builder.make_string ctx.t name null_pos in + (new call_dispatcher ctx (MCall [e2]) with_type p)#field_call sea.se_access [sea.se_this;e_name;e_rhs] [] + in + let e = BinopResult.to_texpr vr r_rhs assign in + vr#to_texpr e + ) + +let type_binop ctx op e1 e2 is_assign_op with_type p = + match op with + | OpAssign -> + type_assign ctx e1 e2 with_type p + | OpAssignOp (OpBoolAnd | OpBoolOr) -> + error "The operators ||= and &&= are not supported" p + | OpAssignOp op -> + type_assign_op ctx op e1 e2 with_type p + | _ -> + try + type_non_assign_op ctx op e1 e2 is_assign_op false with_type p + with Not_found -> + let op = if is_assign_op then OpAssignOp op else op in + die ~p ("Failed to type binary operation " ^ (s_binop op)) __LOC__ + + +let type_unop ctx op flag e with_type p = + let try_abstract_unop_overloads e = match follow e.etype with + | TAbstract ({a_impl = Some c} as a,tl) -> + let rec loop opl = match opl with + | [] -> + raise Not_found + | (op2,flag2,cf) :: opl when op == op2 && flag == flag2 -> + let sea = if has_class_field_flag cf CfImpl then + make_abstract_static_extension_access a tl c cf e false p + else + make_static_extension_access c cf e false p + in + begin try + unify_field_call ctx sea.se_access [sea.se_this] [] p false + with Error _ -> + loop opl + end + | (_,_,cf) :: opl -> + loop opl + in + let fcc = loop a.a_unops in + ignore(follow fcc.fc_field.cf_type); + begin match fcc.fc_field.cf_expr with + | None -> + mk (TUnop(op,flag,e)) fcc.fc_ret p + | Some _ -> + fcc.fc_data() + end + | _ -> + raise Not_found + in + let unexpected_spread p = + error "Spread unary operator is only allowed for unpacking the last argument in a call with rest arguments" p + in + let make e = + let check_int () = + match classify e.etype with + | KFloat -> ctx.t.tfloat + | KNumParam t -> + unify ctx e.etype ctx.t.tfloat e.epos; + t + | k -> + if unify_int ctx e k then ctx.t.tint else ctx.t.tfloat + in + let t = match op with + | Not -> + if flag = Postfix then error "Postfix ! is not supported" p; + unify ctx e.etype ctx.t.tbool e.epos; + ctx.t.tbool + | NegBits -> + unify ctx e.etype ctx.t.tint e.epos; + ctx.t.tint + | Increment + | Decrement -> + check_assign ctx e; + check_int() + | Neg -> + check_int() + | Spread -> + unexpected_spread p + in + mk (TUnop (op,flag,e)) t p + in + let find_overload_or_make e = + try + try_abstract_unop_overloads e + with Not_found -> + make e + in + match op with + | Spread -> + unexpected_spread p + | Not | Neg | NegBits -> + let access_get = !type_access_ref ctx (fst e) (snd e) MGet WithType.value (* WITHTYPETODO *) in + let e = acc_get ctx access_get p in + find_overload_or_make e + | Increment | Decrement -> + let binop = if op = Increment then OpAdd else OpSub in + let e_one = mk (TConst (TInt Int32.one)) ctx.t.tint p in + let maybe_tempvar_postfix vr e_lhs = + if flag = Postfix && with_type <> WithType.no_value then begin + let e_lhs = vr#get_expr "lhs" e_lhs in + e_lhs,Some (vr#as_var "postfix" e_lhs) + end else + e_lhs,None + in + let read_on vr ef fa = + let access_get = type_field_default_cfg ctx ef fa.fa_field.cf_name p MGet WithType.value in + let e_lhs = acc_get ctx access_get p in + let e_lhs,e_out = maybe_tempvar_postfix vr e_lhs in + e_lhs,e_out + in + let generate vr e_out e = match e_out with + | None -> vr#to_texpr e + | Some e' -> vr#to_texpr_el [e] e' + in + let access_set = !type_access_ref ctx (fst e) (snd e) (MSet None) WithType.value (* WITHTYPETODO *) in + match access_set with + | AKNo name -> + error ("The field or identifier " ^ name ^ " is not accessible for writing") p + | AKExpr e -> + find_overload_or_make e + | AKField fa -> + let vr = new value_reference ctx in + let ef = vr#get_expr_part "fh" fa.fa_on in + let access_get = type_field_default_cfg ctx ef fa.fa_field.cf_name p MGet WithType.value in + let e,e_out = match access_get with + | AKField _ -> + let e = FieldAccess.get_field_expr {fa with fa_on = ef} FGet in + find_overload_or_make e,None + | _ -> + let e_set = FieldAccess.get_field_expr {fa with fa_on = ef} FWrite in + let e_lhs = acc_get ctx access_get p in + let e_lhs,e_out = maybe_tempvar_postfix vr e_lhs in + let e_op = mk (TBinop(binop,e_lhs,e_one)) e_lhs.etype p in + mk (TBinop(OpAssign,e_set,e_op)) e_set.etype p,e_out + in + generate vr e_out e + | AKAccessor fa -> + let vr = new value_reference ctx in + let ef = vr#get_expr_part "fh" fa.fa_on in + let fa = {fa with fa_on = ef} in + let e_lhs,e_out = read_on vr ef fa in + let e_op = mk (TBinop(binop,e_lhs,e_one)) e_lhs.etype p in + let dispatcher = new call_dispatcher ctx (MSet None) WithType.value p in + let e = dispatcher#accessor_call fa [e_op] [] in + generate vr e_out e + | AKUsingAccessor sea -> + let ef,vr = process_lhs_expr ctx "fh" sea.se_this in + let e_lhs,e_out = read_on vr ef sea.se_access in + let e_op = mk (TBinop(binop,e_lhs,e_one)) e_lhs.etype p in + let dispatcher = new call_dispatcher ctx (MSet None) WithType.value p in + let e = dispatcher#accessor_call sea.se_access [ef;e_op] [] in + generate vr e_out e + | AKAccess(a,tl,c,ebase,ekey) -> + begin try + (match op with Increment | Decrement -> () | _ -> raise Not_found); + let v_key = alloc_var VGenerated "tmp" ekey.etype ekey.epos in + let evar_key = mk (TVar(v_key,Some ekey)) ctx.com.basic.tvoid ekey.epos in + let ekey = mk (TLocal v_key) ekey.etype ekey.epos in + (* get *) + let e_get = mk_array_get_call ctx (AbstractCast.find_array_access_raise ctx a tl ekey None p) c ebase p in + let v_get = alloc_var VGenerated "tmp" e_get.etype e_get.epos in + let ev_get = mk (TLocal v_get) v_get.v_type p in + let evar_get = mk (TVar(v_get,Some e_get)) ctx.com.basic.tvoid p in + (* op *) + let e_one = mk (TConst (TInt (Int32.of_int 1))) ctx.com.basic.tint p in + let e_op = mk (TBinop((if op = Increment then OpAdd else OpSub),ev_get,e_one)) ev_get.etype p in + (* set *) + let e_set = mk_array_set_call ctx (AbstractCast.find_array_access_raise ctx a tl ekey (Some e_op) p) c ebase p in + let el = evar_key :: evar_get :: e_set :: (if flag = Postfix then [ev_get] else []) in + mk (TBlock el) e_set.etype p + with Not_found -> + let e = mk_array_get_call ctx (AbstractCast.find_array_access ctx a tl ekey None p) c ebase p in + find_overload_or_make e + end + | AKUsingField _ | AKResolve _ -> + error "Invalid operation" p \ No newline at end of file diff --git a/src/typing/overloadResolution.ml b/src/typing/overloadResolution.ml new file mode 100644 index 00000000..5d1a8308 --- /dev/null +++ b/src/typing/overloadResolution.ml @@ -0,0 +1,99 @@ +open Typecore +open TType +open TUnification +open TFunctions + +let unify_cf map_type c cf el = + let monos = List.map (fun _ -> mk_mono()) cf.cf_params in + match follow (apply_params cf.cf_params monos (map_type cf.cf_type)) with + | TFun(tl'',ret) as tf -> + let rec loop2 acc el tl = match el,tl with + | e :: el,(_,o,t) :: tl -> + begin try + Type.unify e.etype t; + loop2 (e :: acc) el tl + with _ -> + if Type.ExtType.is_rest (follow t) then + match follow t,tl with + | TAbstract({a_path=["haxe"],"Rest"},[t]),[] -> + begin try + let el = List.map (fun e -> unify t e.etype; e) el in + let fcc = make_field_call_candidate ((List.rev acc) @ el) ret monos tf cf (c,cf,monos) in + Some fcc + with _ -> + None + end + | _ -> + Globals.die "" __LOC__ + else + None + end + | [],[] -> + let fcc = make_field_call_candidate (List.rev acc) ret monos tf cf (c,cf,monos) in + Some fcc + | _ -> + None + in + loop2 [] el tl'' + | t -> + None + +let find_overload map_type c cf el = + ExtList.List.filter_map (fun cf -> unify_cf map_type c cf el) (cf :: cf.cf_overloads) + +let filter_overloads candidates = + match Overloads.Resolution.reduce_compatible candidates with + | [fcc] -> Some(fcc.fc_data) + | [] -> None + | ((fcc) :: _) (* as resolved *) -> + (* let st = s_type (print_context()) in + print_endline (Printf.sprintf "Ambiguous overload for %s(%s)" name (String.concat ", " (List.map (fun e -> st e.etype) el))); + List.iter (fun (_,t,(c,cf)) -> + print_endline (Printf.sprintf "\tCandidate: %s.%s(%s)" (s_type_path c.cl_path) cf.cf_name (st t)); + ) resolved; *) + Some(fcc.fc_data) + +let resolve_instance_overload is_ctor map_type c name el = + let candidates = ref [] in + let has_function t1 fcc2 = + begin match follow t1,fcc2.fc_type with + | TFun(tl1,_),TFun(tl2,_) -> type_iseq (TFun(tl1,t_dynamic)) (TFun(tl2,t_dynamic)) + | _ -> false + end + in + let rec loop map_type c = + begin try + let cf = if is_ctor then + (match c.cl_constructor with Some cf -> cf | None -> raise Not_found) + else + PMap.find name c.cl_fields + in + begin match find_overload map_type c cf el with + | [] -> raise Not_found + | l -> + List.iter (fun fcc -> + if not (List.exists (has_function fcc.fc_type) !candidates) then candidates := fcc :: !candidates + ) l + end; + if has_class_field_flag cf CfOverload || cf.cf_overloads <> [] then raise Not_found + with Not_found -> + if (has_class_flag c CInterface) then + List.iter (fun (c,tl) -> loop (apply_params c.cl_params (List.map map_type tl)) c) c.cl_implements + else match c.cl_super with + | None -> () + | Some(c,tl) -> loop (apply_params c.cl_params (List.map map_type tl)) c + end; + in + loop map_type c; + filter_overloads (List.rev !candidates) + +let maybe_resolve_instance_overload is_ctor map_type c cf el = + if has_class_field_flag cf CfOverload || cf.cf_overloads <> [] then + resolve_instance_overload is_ctor map_type c cf.cf_name el + else match unify_cf map_type c cf el with + | Some fcc -> Some (fcc.fc_data) + | None -> Some(c,cf,List.map snd cf.cf_params) + +let maybe_resolve_constructor_overload c tl el = + let cf,c,tl = get_constructor_class c tl in + maybe_resolve_instance_overload true (apply_params c.cl_params tl) c cf el diff --git a/src/typing/typeload.ml b/src/typing/typeload.ml index 452df3dd..29a6217f 100644 --- a/src/typing/typeload.ml +++ b/src/typing/typeload.ml @@ -59,7 +59,7 @@ let check_field_access ctx cff = let _,p2 = List.find (fun (access',_) -> access = access') acc in if p1 <> null_pos && p2 <> null_pos then begin display_error ctx (Printf.sprintf "Duplicate access modifier %s" (Ast.s_access access)) p1; - display_error ctx "Previously defined here" p2; + display_error ctx (compl_msg "Previously defined here") p2; end; loop p1 acc l with Not_found -> match access with @@ -67,7 +67,7 @@ let check_field_access ctx cff = begin try let _,p2 = List.find (fun (access',_) -> match access' with APublic | APrivate -> true | _ -> false) acc in display_error ctx (Printf.sprintf "Conflicting access modifier %s" (Ast.s_access access)) p1; - display_error ctx "Conflicts with this" p2; + display_error ctx (compl_msg "Conflicts with this") p2; loop p1 acc l with Not_found -> loop p1 ((access,p1) :: acc) l @@ -86,12 +86,12 @@ let find_type_in_module m tname = ) m.m_types (* raises Type_not_found *) -let find_type_in_module_raise m tname p = +let find_type_in_module_raise ctx m tname p = try List.find (fun mt -> let infos = t_infos mt in if snd infos.mt_path = tname then - if infos.mt_private then + if ctx.m.curmod != infos.mt_module && infos.mt_private then raise_error (Type_not_found (m.m_path,tname,Private_type)) p else true @@ -104,7 +104,7 @@ let find_type_in_module_raise m tname p = (* raises Module_not_found or Type_not_found *) let load_type_raise ctx mpath tname p = let m = ctx.g.do_load_module ctx mpath p in - find_type_in_module_raise m tname p + find_type_in_module_raise ctx m tname p (* raises Not_found *) let load_type ctx mpath tname p = try @@ -193,7 +193,7 @@ let load_unqualified_type_def ctx mname tname p = if resume then find_type_in_module m tname else - find_type_in_module_raise m tname p + find_type_in_module_raise ctx m tname p in find_in_unqualified_modules ctx mname p find_type ~resume:false @@ -209,7 +209,7 @@ let load_module ctx path p = let load_qualified_type_def ctx pack mname tname p = let m = load_module ctx (pack,mname) p in - find_type_in_module_raise m tname p + find_type_in_module_raise ctx m tname p (* load a type or a subtype definition @@ -239,36 +239,6 @@ let resolve_position_by_path ctx path p = let p = (t_infos mt).mt_pos in raise_positions [p] -let check_param_constraints ctx types t pl c p = - match follow t with - | TMono _ -> () - | _ -> - let ctl = (match c.cl_kind with KTypeParameter l -> l | _ -> []) in - List.iter (fun ti -> - let ti = apply_params types pl ti in - let ti = (match follow ti with - | TInst ({ cl_kind = KGeneric } as c,pl) -> - (* if we solve a generic contraint, let's substitute with the actual generic instance before unifying *) - let _,_, f = ctx.g.do_build_instance ctx (TClassDecl c) p in - f pl - | _ -> ti - ) in - try - unify_raise ctx t ti p - with Error(Unify l,p) -> - let fail() = - if not ctx.untyped then display_error ctx (error_msg (Unify (Constraint_failure (s_type_path c.cl_path) :: l))) p; - in - match follow t with - | TInst({cl_kind = KExpr e},_) -> - let e = type_expr {ctx with locals = PMap.empty} e (WithType.with_type ti) in - begin try unify_raise ctx e.etype ti p - with Error (Unify _,_) -> fail() end - | _ -> - fail() - - ) ctl - let generate_args_meta com cls_opt add_meta args = let values = List.fold_left (fun acc ((name,p),_,_,_,eo) -> match eo with Some e -> ((name,p,NoQuotes),e) :: acc | _ -> acc) [] args in (match values with @@ -307,6 +277,29 @@ let make_extension_type ctx tl = let ta = mk_anon ~fields (ref (Extend tl)) in ta +let check_param_constraints ctx t map c p = + match follow t with + | TMono _ -> () + | _ -> + let ctl = (match c.cl_kind with KTypeParameter l -> l | _ -> []) in + List.iter (fun ti -> + let ti = map ti in + try + unify_raise ctx t ti p + with Error(Unify l,p) -> + let fail() = + if not ctx.untyped then display_error ctx (error_msg (Unify (Constraint_failure (s_type_path c.cl_path) :: l))) p; + in + match follow t with + | TInst({cl_kind = KExpr e},_) -> + let e = type_expr {ctx with locals = PMap.empty} e (WithType.with_type ti) in + begin try unify_raise ctx e.etype ti p + with Error (Unify _,_) -> fail() end + | _ -> + fail() + + ) ctl + (* build an instance from a full type *) let rec load_instance' ctx (t,p) allow_no_params = let t = try @@ -316,9 +309,10 @@ let rec load_instance' ctx (t,p) allow_no_params = pt with Not_found -> let mt = load_type_def ctx p t in - let is_generic,is_generic_build = match mt with - | TClassDecl {cl_kind = KGeneric} -> true,false - | TClassDecl {cl_kind = KGenericBuild _} -> false,true + let is_generic,is_generic_build,is_extern = match mt with + | TClassDecl {cl_kind = KGeneric} -> true,false,false + | TClassDecl {cl_kind = KGenericBuild _} -> false,true,false + | TClassDecl c when (has_class_flag c CExtern) -> false,false,true | TTypeDecl td -> DeprecationCheck.if_enabled ctx.com (fun() -> try @@ -330,30 +324,23 @@ let rec load_instance' ctx (t,p) allow_no_params = with Not_found -> () ); - false,false - | _ -> false,false + false,false,false + | _ -> false,false,false in let types , path , f = ctx.g.do_build_instance ctx mt p in let is_rest = is_generic_build && (match types with ["Rest",_] -> true | _ -> false) in if allow_no_params && t.tparams = [] && not is_rest then begin - let pl = ref [] in - pl := List.map (fun (name,t) -> - match follow t with - | TInst (c,_) -> - let t = mk_mono() in - if c.cl_kind <> KTypeParameter [] || is_generic then delay ctx PCheckConstraint (fun() -> check_param_constraints ctx types t (!pl) c p); - t; - | _ -> die "" __LOC__ - ) types; - f (!pl) + let monos = Monomorph.spawn_constrained_monos (fun t -> t) types in + f (monos) end else if path = ([],"Dynamic") then match t.tparams with | [] -> t_dynamic | [TPType t] -> TDynamic (load_complex_type ctx true t) | _ -> error "Too many parameters for Dynamic" p else begin - if not is_rest && ctx.com.display.dms_error_policy <> EPIgnore && List.length types <> List.length t.tparams then error ("Invalid number of type parameters for " ^ s_type_path path) p; - let tparams = List.map (fun t -> + let is_java_rest = ctx.com.platform = Java && is_extern in + let is_rest = is_rest || is_java_rest in + let load_param t = match t with | TPExpr e -> let name = (match fst e with @@ -367,11 +354,13 @@ let rec load_instance' ctx (t,p) allow_no_params = ) in let c = mk_class ctx.m.curmod ([],name) p (pos e) in c.cl_kind <- KExpr e; - TInst (c,[]) - | TPType t -> load_complex_type ctx true t - ) t.tparams in + TInst (c,[]),pos e + | TPType t -> load_complex_type ctx true t,pos t + in + let checks = DynArray.create () in let rec loop tl1 tl2 is_rest = match tl1,tl2 with | t :: tl1,(name,t2) :: tl2 -> + let t,pt = load_param t in let check_const c = let is_expression = (match t with TInst ({ cl_kind = KExpr _ },_) -> true | _ -> false) in let expects_expression = name = "Const" || Meta.has Meta.Const c.cl_meta in @@ -389,12 +378,8 @@ let rec load_instance' ctx (t,p) allow_no_params = t | TInst (c,[]) -> check_const c; - let r = exc_protect ctx (fun r -> - r := lazy_available t; - delay ctx PCheckConstraint (fun() -> check_param_constraints ctx types t tparams c p); - t - ) "constraint" in - TLazy r + DynArray.add checks (t,c,pt); + t | _ -> die "" __LOC__ in t :: loop tl1 tl2 is_rest @@ -402,28 +387,50 @@ let rec load_instance' ctx (t,p) allow_no_params = [] | [],["Rest",_] when is_generic_build -> [] - | [],(_,t) :: tl when ctx.com.display.dms_error_policy = EPIgnore -> - t :: loop [] tl is_rest - | [],_ -> - error ("Not enough type parameters for " ^ s_type_path path) p + | [],(_,t) :: tl -> + if is_java_rest then + t_dynamic :: loop [] tl is_rest + else if ctx.com.display.dms_error_policy = EPIgnore then + t :: loop [] tl is_rest + else + error ("Not enough type parameters for " ^ s_type_path path) p | t :: tl,[] -> + let t,pt = load_param t in if is_rest then t :: loop tl [] true else if ctx.com.display.dms_error_policy = EPIgnore then [] else - error ("Too many parameters for " ^ s_type_path path) p + error ("Too many type parameters for " ^ s_type_path path) pt in - let params = loop tparams types false in + let params = loop t.tparams types false in + if not is_rest then begin + let map t = + let t = apply_params types params t in + let t = (match follow t with + | TInst ({ cl_kind = KGeneric } as c,pl) -> + (* if we solve a generic contraint, let's substitute with the actual generic instance before unifying *) + let _,_, f = ctx.g.do_build_instance ctx (TClassDecl c) p in + f pl + | _ -> t + ) in + t + in + delay ctx PCheckConstraint (fun () -> + DynArray.iter (fun (t,c,p) -> + check_param_constraints ctx t map c p + ) checks + ); + end; f params end in t -and load_instance ctx ?(allow_display=false) (t,pn) allow_no_params = +and load_instance ctx ?(allow_display=false) ((_,pn) as tp) allow_no_params = try - let t = load_instance' ctx (t,pn) allow_no_params in - if allow_display then DisplayEmitter.check_display_type ctx t pn; + let t = load_instance' ctx tp allow_no_params in + if allow_display then DisplayEmitter.check_display_type ctx t tp; t with Error (Module_not_found path,_) when ctx.macro_depth <= 0 && (ctx.com.display.dms_kind = DMDefault) && DisplayPosition.display_position#enclosed_in pn -> let s = s_type_path path in @@ -435,6 +442,7 @@ and load_instance ctx ?(allow_display=false) (t,pn) allow_no_params = and load_complex_type' ctx allow_display (t,p) = match t with | CTParent t -> load_complex_type ctx allow_display t + | CTPath { tpackage = ["$"]; tname = "_hx_mono" } -> spawn_monomorph ctx p | CTPath t -> load_instance ~allow_display ctx (t,p) false | CTOptional _ -> error "Optional type not allowed here" p | CTNamed _ -> error "Named type not allowed here" p @@ -537,7 +545,7 @@ and load_complex_type' ctx allow_display (t,p) = pub := false; | ADynamic when (match f.cff_kind with FFun _ -> true | _ -> false) -> dyn := true | AFinal -> final := true - | AStatic | AOverride | AInline | ADynamic | AMacro | AExtern as a -> error ("Invalid access " ^ Ast.s_access a) p + | AStatic | AOverride | AInline | ADynamic | AMacro | AExtern | AAbstract | AOverload as a -> error ("Invalid access " ^ Ast.s_access a) p ) f.cff_access; let t , access = (match f.cff_kind with | FVar(t,e) when !final -> @@ -615,7 +623,7 @@ and load_complex_type ctx allow_display (t,pn) = try load_complex_type' ctx allow_display (t,pn) with Error(Module_not_found(([],name)),p) as exc -> - if Diagnostics.is_diagnostics_run p then begin + if Diagnostics.is_diagnostics_run ctx.com p then begin delay ctx PForce (fun () -> DisplayToplevel.handle_unresolved_identifier ctx name p true); t_dynamic end else if ctx.com.display.dms_display && not (DisplayPosition.display_position#enclosed_in pn) then @@ -660,7 +668,8 @@ and init_meta_overloads ctx co cf = ctx.type_params <- old; false | (Meta.Overload,[],_) when ctx.com.config.pf_overload -> - let topt (n,_,t) = match t with | TMono t when t.tm_type = None -> error ("Explicit type required for overload functions\nFor function argument '" ^ n ^ "'") cf.cf_pos | _ -> () in + add_class_field_flag cf CfOverload; + let topt (n,_,t) = match t with | TMono t when t.tm_type = None -> error ("Explicit type required for overload functions\n... For function argument '" ^ n ^ "'") cf.cf_pos | _ -> () in (match follow cf.cf_type with | TFun (args,_) -> List.iter topt args | _ -> () (* could be a variable *)); @@ -726,7 +735,7 @@ let t_iterator ctx = *) let load_type_hint ?(opt=false) ctx pcur t = let t = match t with - | None -> mk_mono() + | None -> spawn_monomorph ctx pcur | Some (t,p) -> load_complex_type ctx true (t,p) in if opt then ctx.t.tnull t else t @@ -900,7 +909,7 @@ let init_core_api ctx c = ) fcore; PMap.iter (fun i f -> let p = (match f.cf_expr with None -> c.cl_pos | Some e -> e.epos) in - if (has_class_field_flag f CfPublic) && not (Meta.has Meta.Hack f.cf_meta) && not (PMap.mem f.cf_name fcore) && not (List.memq f c.cl_overrides) then error ("Public field " ^ i ^ " is not part of core type") p; + if (has_class_field_flag f CfPublic) && not (Meta.has Meta.Hack f.cf_meta) && not (PMap.mem f.cf_name fcore) && not (has_class_field_flag f CfOverride) then error ("Public field " ^ i ^ " is not part of core type") p; ) fl; in check_fields ccore.cl_fields c.cl_fields; @@ -930,7 +939,7 @@ let handle_using ctx path p = | None -> let md = ctx.g.do_load_module ctx (t.tpackage,t.tname) p in let types = List.filter (fun t -> not (t_infos t).mt_private) md.m_types in - types + Option.map_default (fun c -> (TClassDecl c) :: types) types md.m_statics | Some _ -> let t = load_type_def ctx p t in [t] diff --git a/src/typing/typeloadCheck.ml b/src/typing/typeloadCheck.ml index 22a26e8a..f7981583 100644 --- a/src/typing/typeloadCheck.ml +++ b/src/typing/typeloadCheck.ml @@ -39,7 +39,7 @@ let is_generic_parameter ctx c = (* first check field parameters, then class parameters *) try ignore (List.assoc (snd c.cl_path) ctx.curfield.cf_params); - Meta.has Meta.Generic ctx.curfield.cf_meta + has_class_field_flag ctx.curfield CfGeneric with Not_found -> try ignore(List.assoc (snd c.cl_path) ctx.type_params); (match ctx.curclass.cl_kind with | KGeneric -> true | _ -> false); @@ -151,7 +151,7 @@ let get_native_name meta = let check_native_name_override ctx child base = let error base_pos child_pos = display_error ctx ("Field " ^ child.cf_name ^ " has different @:native value than in superclass") child_pos; - display_error ctx ("Base field is defined here") base_pos + display_error ctx (compl_msg "Base field is defined here") base_pos in try let child_name, child_pos = get_native_name child.cf_meta in @@ -166,25 +166,33 @@ let check_native_name_override ctx child base = let check_overriding ctx c f = match c.cl_super with | None -> - if List.memq f c.cl_overrides then display_error ctx ("Field " ^ f.cf_name ^ " is declared 'override' but doesn't override any field") f.cf_pos - | _ when c.cl_extern && Meta.has Meta.CsNative c.cl_meta -> () (* -net-lib specific: do not check overrides on extern CsNative classes *) + if has_class_field_flag f CfOverride then display_error ctx ("Field " ^ f.cf_name ^ " is declared 'override' but doesn't override any field") f.cf_pos + | _ when (has_class_flag c CExtern) && Meta.has Meta.CsNative c.cl_meta -> () (* -net-lib specific: do not check overrides on extern CsNative classes *) | Some (csup,params) -> let p = f.cf_name_pos in let i = f.cf_name in let check_field f get_super_field is_overload = try - (if is_overload && not (Meta.has Meta.Overload f.cf_meta) then - display_error ctx ("Missing @:overload declaration for field " ^ i) p); + (if is_overload && not (has_class_field_flag f CfOverload) then + display_error ctx ("Missing overload declaration for field " ^ i) p); + let f_has_override = has_class_field_flag f CfOverride in let t, f2 = get_super_field csup i in check_native_name_override ctx f f2; (* allow to define fields that are not defined for this platform version in superclass *) (match f2.cf_kind with | Var { v_read = AccRequire _ } -> raise Not_found; | _ -> ()); - if ctx.com.config.pf_overload && (Meta.has Meta.Overload f2.cf_meta && not (Meta.has Meta.Overload f.cf_meta)) then - display_error ctx ("Field " ^ i ^ " should be declared with @:overload since it was already declared as @:overload in superclass") p - else if not (List.memq f c.cl_overrides) then - display_error ctx ("Field " ^ i ^ " should be declared with 'override' since it is inherited from superclass " ^ s_type_path csup.cl_path) p - else if not (has_class_field_flag f CfPublic) && (has_class_field_flag f2 CfPublic) then + if has_class_field_flag f2 CfAbstract then begin + if f_has_override then + display_error ctx ("Field " ^ i ^ " is declared 'override' but parent field " ^ i ^ " is 'abstract' and does not provide any implementation to override") p + else + add_class_field_flag f CfOverride (* our spec requires users to not "override" abstract functions, but our implementation depends on implementations to be declared with "override" ¯\_(ツ)_/¯ *) + end; + if (has_class_field_flag f2 CfOverload && not (has_class_field_flag f CfOverload)) then + display_error ctx ("Field " ^ i ^ " should be declared with overload since it was already declared as overload in superclass") p + else if not f_has_override && not (has_class_field_flag f2 CfAbstract) then begin + if has_class_flag c CExtern then add_class_field_flag f CfOverride + else display_error ctx ("Field " ^ i ^ " should be declared with 'override' since it is inherited from superclass " ^ s_type_path csup.cl_path) p + end else if not (has_class_field_flag f CfPublic) && (has_class_field_flag f2 CfPublic) then display_error ctx ("Field " ^ i ^ " has less visibility (public/private) than superclass one") p else (match f.cf_kind, f2.cf_kind with | _, Method MethInline -> @@ -201,11 +209,11 @@ let check_overriding ctx c f = with Unify_error l -> display_error ctx ("Field " ^ i ^ " overrides parent class with different or incomplete type") p; - display_error ctx ("Base field is defined here") f2.cf_name_pos; - display_error ctx (error_msg (Unify l)) p; + display_error ctx (compl_msg "Base field is defined here") f2.cf_name_pos; + display_error ctx (compl_msg (error_msg (Unify l))) p; with Not_found -> - if List.memq f c.cl_overrides then + if has_class_field_flag f CfOverride then let msg = if is_overload then ("Field " ^ i ^ " is declared 'override' but no compatible overload was found") else begin @@ -218,8 +226,8 @@ let check_overriding ctx c f = end in display_error ctx msg p in - if ctx.com.config.pf_overload && Meta.has Meta.Overload f.cf_meta then begin - let overloads = Overloads.get_overloads csup i in + if has_class_field_flag f CfOverload then begin + let overloads = Overloads.get_overloads ctx.com csup i in List.iter (fun (t,f2) -> (* check if any super class fields are vars *) match f2.cf_kind with @@ -325,7 +333,7 @@ module Inheritance = struct let check_extends ctx c t p = match follow t with | TInst (csup,params) -> - if is_basic_class_path csup.cl_path && not (c.cl_extern && csup.cl_extern) then error "Cannot extend basic class" p; + if is_basic_class_path csup.cl_path && not ((has_class_flag c CExtern) && (has_class_flag csup CExtern)) then error "Cannot extend basic class" p; if extends csup c then error "Recursive class" p; begin match csup.cl_kind with | KTypeParameter _ -> @@ -335,69 +343,147 @@ module Inheritance = struct end | _ -> error "Should extend by using a class" p - let rec check_interface ctx c intf params = + let rec check_interface ctx missing c intf params = + List.iter (fun (i2,p2) -> + check_interface ctx missing c i2 (List.map (apply_params intf.cl_params params) p2) + ) intf.cl_implements; let p = c.cl_name_pos in let rec check_field i f = - (if ctx.com.config.pf_overload then - List.iter (function - | f2 when f != f2 -> - check_field i f2 - | _ -> ()) f.cf_overloads); + let t = (apply_params intf.cl_params params f.cf_type) in let is_overload = ref false in try let t2, f2 = class_field_no_interf c i in let t2, f2 = - if ctx.com.config.pf_overload && (f2.cf_overloads <> [] || Meta.has Meta.Overload f2.cf_meta) then - let overloads = Overloads.get_overloads c i in + if f2.cf_overloads <> [] || has_class_field_flag f2 CfOverload then + let overloads = Overloads.get_overloads ctx.com c i in is_overload := true; - let t = (apply_params intf.cl_params params f.cf_type) in List.find (fun (t1,f1) -> Overloads.same_overload_args t t1 f f1) overloads else t2, f2 in - ignore(follow f2.cf_type); (* force evaluation *) - let p = f2.cf_name_pos in - let mkind = function - | MethNormal | MethInline -> 0 - | MethDynamic -> 1 - | MethMacro -> 2 - in - if (has_class_field_flag f CfPublic) && not (has_class_field_flag f2 CfPublic) && not (Meta.has Meta.CompilerGenerated f.cf_meta) then - display_error ctx ("Field " ^ i ^ " should be public as requested by " ^ s_type_path intf.cl_path) p - else if not (unify_kind f2.cf_kind f.cf_kind) || not (match f.cf_kind, f2.cf_kind with Var _ , Var _ -> true | Method m1, Method m2 -> mkind m1 = mkind m2 | _ -> false) then - display_error ctx ("Field " ^ i ^ " has different property access than in " ^ s_type_path intf.cl_path ^ " (" ^ s_kind f2.cf_kind ^ " should be " ^ s_kind f.cf_kind ^ ")") p - else try - valid_redefinition ctx f2 t2 f (apply_params intf.cl_params params f.cf_type) - with - Unify_error l -> - if not (Meta.has Meta.CsNative c.cl_meta && c.cl_extern) then begin - display_error ctx ("Field " ^ i ^ " has different type than in " ^ s_type_path intf.cl_path) p; - display_error ctx ("Interface field is defined here") f.cf_pos; - display_error ctx (error_msg (Unify l)) p; - end - with - | Not_found when not c.cl_interface -> - let msg = if !is_overload then - let ctx = print_context() in - let args = match follow f.cf_type with | TFun(args,_) -> String.concat ", " (List.map (fun (n,o,t) -> (if o then "?" else "") ^ n ^ " : " ^ (s_type ctx t)) args) | _ -> die "" __LOC__ in - "No suitable overload for " ^ i ^ "( " ^ args ^ " ), as needed by " ^ s_type_path intf.cl_path ^ " was found" - else - ("Field " ^ i ^ " needed by " ^ s_type_path intf.cl_path ^ " is missing") + delay ctx PForce (fun () -> + ignore(follow f2.cf_type); (* force evaluation *) + let p = f2.cf_name_pos in + let mkind = function + | MethNormal | MethInline -> 0 + | MethDynamic -> 1 + | MethMacro -> 2 in - display_error ctx msg p + if (has_class_field_flag f CfPublic) && not (has_class_field_flag f2 CfPublic) && not (Meta.has Meta.CompilerGenerated f.cf_meta) then + display_error ctx ("Field " ^ i ^ " should be public as requested by " ^ s_type_path intf.cl_path) p + else if not (unify_kind f2.cf_kind f.cf_kind) || not (match f.cf_kind, f2.cf_kind with Var _ , Var _ -> true | Method m1, Method m2 -> mkind m1 = mkind m2 | _ -> false) then + display_error ctx ("Field " ^ i ^ " has different property access than in " ^ s_type_path intf.cl_path ^ " (" ^ s_kind f2.cf_kind ^ " should be " ^ s_kind f.cf_kind ^ ")") p + else try + valid_redefinition ctx f2 t2 f (apply_params intf.cl_params params f.cf_type) + with + Unify_error l -> + if not (Meta.has Meta.CsNative c.cl_meta && (has_class_flag c CExtern)) then begin + display_error ctx ("Field " ^ i ^ " has different type than in " ^ s_type_path intf.cl_path) p; + display_error ctx (compl_msg "Interface field is defined here") f.cf_pos; + display_error ctx (compl_msg (error_msg (Unify l))) p; + end + ) + with + | Not_found when (has_class_flag c CAbstract) -> + let cf = {f with cf_overloads = []} in + add_class_field_flag cf CfAbstract; + begin try + let cf' = PMap.find cf.cf_name c.cl_fields in + Hashtbl.remove ctx.com.overload_cache (c.cl_path,i); + cf'.cf_overloads <- cf :: cf'.cf_overloads + with Not_found -> + TClass.add_field c cf + end + | Not_found when not (has_class_flag c CInterface) -> + if Diagnostics.is_diagnostics_run ctx.com c.cl_pos then + DynArray.add missing (f,t) + else begin + let msg = if !is_overload then + let ctx = print_context() in + let args = match follow f.cf_type with | TFun(args,_) -> String.concat ", " (List.map (fun (n,o,t) -> (if o then "?" else "") ^ n ^ " : " ^ (s_type ctx t)) args) | _ -> die "" __LOC__ in + "No suitable overload for " ^ i ^ "( " ^ args ^ " ), as needed by " ^ s_type_path intf.cl_path ^ " was found" + else + ("Field " ^ i ^ " needed by " ^ s_type_path intf.cl_path ^ " is missing") + in + display_error ctx msg p + end | Not_found -> () in - PMap.iter check_field intf.cl_fields; - List.iter (fun (i2,p2) -> - check_interface ctx c i2 (List.map (apply_params intf.cl_params params) p2) - ) intf.cl_implements + let check_field i cf = + check_field i cf; + if has_class_field_flag cf CfOverload then + List.iter (check_field i) (List.rev cf.cf_overloads) + in + PMap.iter check_field intf.cl_fields let check_interfaces ctx c = match c.cl_path with | "Proxy" :: _ , _ -> () - | _ when c.cl_extern && Meta.has Meta.CsNative c.cl_meta -> () + | _ when (has_class_flag c CExtern) && Meta.has Meta.CsNative c.cl_meta -> () | _ -> - List.iter (fun (intf,params) -> check_interface ctx c intf params) c.cl_implements + List.iter (fun (intf,params) -> + let missing = DynArray.create () in + check_interface ctx missing c intf params; + if DynArray.length missing > 0 then begin + let l = DynArray.to_list missing in + let diag = { + mf_pos = c.cl_name_pos; + mf_on = TClassDecl c; + mf_fields = List.map (fun (cf,t) -> (cf,t,CompletionType.from_type (Display.get_import_status ctx) t)) l; + mf_cause = ImplementedInterface(intf,params); + } in + let display = ctx.com.display_information in + display.module_diagnostics <- MissingFields diag :: display.module_diagnostics + end + ) c.cl_implements + + let check_abstract_class ctx c csup params = + let missing = ref [] in + let map = apply_params csup.cl_params params in + let check_abstract_class_field cf1 t1 = + try + let cf2 = PMap.find cf1.cf_name c.cl_fields in + if not (List.exists (fun cf2 -> + Overloads.same_overload_args t1 cf2.cf_type cf1 cf2 + ) (cf2 :: cf2.cf_overloads)) then + missing := (cf1,t1) :: !missing + with Not_found -> + missing := (cf1,t1) :: !missing + in + let cfl = TClass.get_all_fields csup params in + PMap.iter (fun _ (_,cf) -> + let cfl = Overloads.collect_overloads map csup cf.cf_name in + List.iter (fun (t,cf) -> + if (has_class_field_flag cf CfAbstract) then + check_abstract_class_field cf t + ) cfl + ) cfl; + match !missing with + | [] -> + () + | l when Diagnostics.is_diagnostics_run ctx.com c.cl_pos -> + let diag = { + mf_pos = c.cl_name_pos; + mf_on = TClassDecl c; + mf_fields = List.rev_map (fun (cf,t) -> (cf,t,CompletionType.from_type (Display.get_import_status ctx) t)) l; + mf_cause = AbstractParent(csup,params); + } in + let display = ctx.com.display_information in + display.module_diagnostics <- MissingFields diag :: display.module_diagnostics + | l -> + let singular = match l with [_] -> true | _ -> false in + display_error ctx (Printf.sprintf "This class extends abstract class %s but doesn't implement the following method%s" (s_type_path csup.cl_path) (if singular then "" else "s")) c.cl_name_pos; + display_error ctx (Printf.sprintf "Implement %s or make %s abstract as well" (if singular then "it" else "them") (s_type_path c.cl_path)) c.cl_name_pos; + let pctx = print_context() in + List.iter (fun (cf,_) -> + let s = match follow cf.cf_type with + | TFun(tl,tr) -> + String.concat ", " (List.map (fun (n,o,t) -> Printf.sprintf "%s:%s" n (s_type pctx t)) tl) + | t -> + s_type pctx t + in + display_error ctx (Printf.sprintf "... %s(%s)" cf.cf_name s) cf.cf_name_pos + ) (List.rev !missing) let set_heritance ctx c herits p = let is_lib = Meta.has Meta.LibType c.cl_meta in @@ -409,8 +495,8 @@ module Inheritance = struct | Meta.AutoBuild, el, p -> c.cl_meta <- (Meta.Build,el,{ c.cl_pos with pmax = c.cl_pos.pmin }(* prevent display metadata *)) :: m :: c.cl_meta | _ -> () ) csup.cl_meta; - if csup.cl_final && not ((csup.cl_extern && Meta.has Meta.Hack c.cl_meta) || (match c.cl_kind with KTypeParameter _ -> true | _ -> false)) then - error ("Cannot extend a final " ^ if c.cl_interface then "interface" else "class") p; + if has_class_flag csup CFinal && not (((has_class_flag csup CExtern) && Meta.has Meta.Hack c.cl_meta) || (match c.cl_kind with KTypeParameter _ -> true | _ -> false)) then + error ("Cannot extend a final " ^ if (has_class_flag c CInterface) then "interface" else "class") p; in let check_cancel_build csup = match csup.cl_build() with @@ -454,15 +540,15 @@ module Inheritance = struct if is_extends then begin if c.cl_super <> None then error "Cannot extend several classes" p; let csup,params = check_extends ctx c t p in - if c.cl_interface then begin - if not csup.cl_interface then error "Cannot extend by using a class" p; + if (has_class_flag c CInterface) then begin + if not (has_class_flag csup CInterface) then error "Cannot extend by using a class" p; c.cl_implements <- (csup,params) :: c.cl_implements; if not !has_interf then begin - if not is_lib then delay ctx PForce (fun() -> check_interfaces ctx c); + if not is_lib then delay ctx PConnectField (fun() -> check_interfaces ctx c); has_interf := true; end end else begin - if csup.cl_interface then error "Cannot extend by using an interface" p; + if (has_class_flag csup CInterface) then error "Cannot extend by using an interface" p; c.cl_super <- Some (csup,params) end; (fun () -> @@ -470,17 +556,17 @@ module Inheritance = struct process_meta csup; ) end else begin match follow t with - | TInst ({ cl_path = [],"ArrayAccess"; cl_extern = true; },[t]) -> + | TInst ({ cl_path = [],"ArrayAccess" } as ca,[t]) when (has_class_flag ca CExtern) -> if c.cl_array_access <> None then error "Duplicate array access" p; c.cl_array_access <- Some t; (fun () -> ()) | TInst (intf,params) -> if extends intf c then error "Recursive class" p; - if c.cl_interface then error "Interfaces cannot implement another interface (use extends instead)" p; - if not intf.cl_interface then error "You can only implement an interface" p; + if (has_class_flag c CInterface) then error "Interfaces cannot implement another interface (use extends instead)" p; + if not (has_class_flag intf CInterface) then error "You can only implement an interface" p; c.cl_implements <- (intf, params) :: c.cl_implements; if not !has_interf && not is_lib && not (Meta.has (Meta.Custom "$do_not_check_interf") c.cl_meta) then begin - delay ctx PForce (fun() -> check_interfaces ctx c); + delay ctx PConnectField (fun() -> check_interfaces ctx c); has_interf := true; end; (fun () -> @@ -489,7 +575,7 @@ module Inheritance = struct ) | TDynamic t -> if c.cl_dynamic <> None then error "Cannot have several dynamics" p; - if not c.cl_extern then display_error ctx "In haxe 4, implements Dynamic is only supported on externs" p; + if not (has_class_flag c CExtern) then display_error ctx "In haxe 4, implements Dynamic is only supported on externs" p; c.cl_dynamic <- Some t; (fun () -> ()) | _ -> @@ -502,20 +588,20 @@ module Inheritance = struct Typeload.load_instance ~allow_display:true ctx (ct,p) false with DisplayException(DisplayFields Some({fkind = CRTypeHint} as r)) -> (* We don't allow `implements` on interfaces. Just raise fields completion with no fields. *) - if not is_extends && c.cl_interface then raise_fields [] CRImplements r.fsubject; + if not is_extends && (has_class_flag c CInterface) then raise_fields [] CRImplements r.fsubject; let l = List.filter (fun item -> match item.ci_kind with - | ITType({kind = Interface} as cm,_) -> (not is_extends || c.cl_interface) && CompletionModuleType.get_path cm <> c.cl_path + | ITType({kind = Interface} as cm,_) -> (not is_extends || (has_class_flag c CInterface)) && CompletionModuleType.get_path cm <> c.cl_path | ITType({kind = Class} as cm,_) -> - is_extends && not c.cl_interface && CompletionModuleType.get_path cm <> c.cl_path && + is_extends && not (has_class_flag c CInterface) && CompletionModuleType.get_path cm <> c.cl_path && (not cm.is_final || Meta.has Meta.Hack c.cl_meta) && - (not (is_basic_class_path (cm.pack,cm.name)) || (c.cl_extern && cm.is_extern)) + (not (is_basic_class_path (cm.pack,cm.name)) || ((has_class_flag c CExtern) && cm.is_extern)) | _ -> false ) r.fitems in raise_fields l (if is_extends then CRExtends else CRImplements) r.fsubject in Some (check_herit t is_extends p) with Error(Module_not_found(([],name)),p) when ctx.com.display.dms_kind <> DMNone -> - if Diagnostics.is_diagnostics_run p then DisplayToplevel.handle_unresolved_identifier ctx name p true; + if Diagnostics.is_diagnostics_run ctx.com p then DisplayToplevel.handle_unresolved_identifier ctx name p true; None ) herits in fl diff --git a/src/typing/typeloadFields.ml b/src/typing/typeloadFields.ml index dbcae8fe..1482c32b 100644 --- a/src/typing/typeloadFields.ml +++ b/src/typing/typeloadFields.ml @@ -24,7 +24,8 @@ open Ast open Type open Typecore open Typeload -open DisplayTypes.DisplayMode +open DisplayTypes +open DisplayMode open CompletionItem.ClassFieldOrigin open Common open Error @@ -53,7 +54,7 @@ type class_init_ctx = { mutable has_display_field : bool; mutable delayed_expr : (typer * tlazy ref option) list; mutable force_constructor : bool; - mutable uninitialized_final : pos option; + mutable uninitialized_final : tclass_field list; } type field_kind = @@ -66,11 +67,14 @@ type field_init_ctx = { is_final : bool; is_static : bool; override : pos option; + overload : pos option; is_extern : bool; + is_abstract : bool; is_macro : bool; is_abstract_member : bool; is_display_field : bool; is_field_debug : bool; + is_generic : bool; field_kind : field_kind; display_modifier : placed_access option; mutable do_bind : bool; @@ -80,8 +84,6 @@ type field_init_ctx = { mutable expr_presence_matters : bool; } -let locate_macro_error = ref true - let dump_class_context cctx = Printer.s_record_fields "" [ "tclass",Printer.s_tclass "\t" cctx.tclass; @@ -175,6 +177,7 @@ let ensure_struct_init_constructor ctx c ast_fields p = let super_args,super_expr,super_tl = get_struct_init_super_info ctx c p in let params = List.map snd c.cl_params in let ethis = mk (TConst TThis) (TInst(c,params)) p in + let doc_buf = Buffer.create 0 in let args,el,tl = List.fold_left (fun (args,el,tl) cf -> match cf.cf_kind with | Var { v_write = AccNever } -> args,el,tl | Var _ -> @@ -199,6 +202,17 @@ let ensure_struct_init_constructor ctx c ast_fields p = else assign_expr in + begin match gen_doc_text_opt cf.cf_doc with + | None -> + () + | Some doc -> + Buffer.add_string doc_buf "@param "; + Buffer.add_string doc_buf cf.cf_name; + Buffer.add_string doc_buf " "; + let doc = ExtString.String.trim doc in + Buffer.add_string doc_buf doc; + Buffer.add_string doc_buf "\n"; + end; (v,None) :: args,e :: el,(cf.cf_name,opt,t) :: tl | Method _ -> args,el,tl @@ -211,25 +225,27 @@ let ensure_struct_init_constructor ctx c ast_fields p = } in let e = mk (TFunction tf) (TFun(tl @ super_tl,ctx.t.tvoid)) p in let cf = mk_field "new" e.etype p null_pos in + cf.cf_doc <- doc_from_string (Buffer.contents doc_buf); cf.cf_expr <- Some e; cf.cf_type <- e.etype; - cf.cf_meta <- [Meta.CompilerGenerated,[],null_pos]; + cf.cf_meta <- [Meta.CompilerGenerated,[],null_pos; Meta.InheritDoc,[],null_pos]; cf.cf_kind <- Method MethNormal; - c.cl_constructor <- Some cf + c.cl_constructor <- Some cf; + delay ctx PTypeField (fun() -> InheritDoc.build_class_field_doc ctx (Some c) cf) let transform_abstract_field com this_t a_t a f = let stat = List.mem_assoc AStatic f.cff_access in let p = f.cff_pos in match f.cff_kind with | FProp ((("get" | "never"),_),(("set" | "never"),_),_,_) when not stat -> - { f with cff_access = (AStatic,null_pos) :: f.cff_access; cff_meta = (Meta.Impl,[],null_pos) :: f.cff_meta } - | FProp _ when not stat -> + f + | FProp _ when not stat && not (Meta.has Meta.Enum f.cff_meta) -> error "Member property accessors must be get/set or never" p; | FFun fu when fst f.cff_name = "new" && not stat -> - let init p = (EVars [("this",null_pos),false,Some this_t,None],p) in + let init p = (EVars [mk_evar ~t:this_t ("this",null_pos)],p) in let cast e = (ECast(e,None)),pos e in let ret p = (EReturn (Some (cast (EConst (Ident "this"),p))),p) in - let meta = (Meta.Impl,[],null_pos) :: (Meta.NoCompletion,[],null_pos) :: f.cff_meta in + let meta = (Meta.NoCompletion,[],null_pos) :: f.cff_meta in if Meta.has Meta.MultiType a.a_meta then begin if List.mem_assoc AInline f.cff_access then error "MultiType constructors cannot be inline" f.cff_pos; if fu.f_expr <> None then error "MultiType constructors cannot have a body" f.cff_pos; @@ -250,11 +266,10 @@ let transform_abstract_field com this_t a_t a f = ); f_type = Some a_t; } in - { f with cff_name = "_new",pos f.cff_name; cff_access = (AStatic,null_pos) :: f.cff_access; cff_kind = FFun fu; cff_meta = meta } + { f with cff_name = "_new",pos f.cff_name; cff_kind = FFun fu; cff_meta = meta } | FFun fu when not stat -> if Meta.has Meta.From f.cff_meta then error "@:from cast functions must be static" f.cff_pos; - let fu = { fu with f_args = (if List.mem_assoc AMacro f.cff_access then fu.f_args else (("this",null_pos),false,[],Some this_t,None) :: fu.f_args) } in - { f with cff_kind = FFun fu; cff_access = (AStatic,null_pos) :: f.cff_access; cff_meta = (Meta.Impl,[],null_pos) :: f.cff_meta } + { f with cff_kind = FFun fu } | _ -> f @@ -354,9 +369,18 @@ let build_enum_abstract ctx c a fields p = else if does_unify a.a_this ctx.t.tstring then EAString else EAOther in + let set_field field ct e = + field.cff_access <- (AInline,null_pos) :: field.cff_access; + let e = (ECast(e,None),(pos e)) in + field.cff_kind <- FVar(ct,Some e) + and field_is_set field = + match field.cff_kind with + | FVar(Some _, Some ((ECast _),_)) -> List.exists (fun (access,_) -> access = AInline) field.cff_access + | _ -> false + in List.iter (fun field -> match field.cff_kind with - | FVar(ct,eo) when not (List.mem_assoc AStatic field.cff_access) -> + | FVar(ct,eo) when not (List.mem_assoc AStatic field.cff_access) && not (field_is_set field) -> let check_visibility_conflict visibility p1 = match visibility with | VUnknown -> @@ -381,24 +405,19 @@ let build_enum_abstract ctx c a fields p = visibility in let visibility = loop VUnknown field.cff_access in - field.cff_access <- [AStatic,null_pos; match visibility with VPublic acc | VPrivate acc -> acc | VUnknown -> (APublic,null_pos)]; - field.cff_meta <- (Meta.Enum,[],null_pos) :: (Meta.Impl,[],null_pos) :: field.cff_meta; + field.cff_access <- [match visibility with VPublic acc | VPrivate acc -> acc | VUnknown -> (APublic,null_pos)]; + field.cff_meta <- (Meta.Enum,[],null_pos) :: field.cff_meta; let ct = match ct with | Some _ -> ct | None -> Some (TExprToExpr.convert_type (TAbstract(a,List.map snd a.a_params)),null_pos) in - let set_field e = - field.cff_access <- (AInline,null_pos) :: field.cff_access; - let e = (ECast(e,None),(pos e)) in - field.cff_kind <- FVar(ct,Some e) - in begin match eo with | None -> - if not c.cl_extern then begin match mode with + if not (has_class_flag c CExtern) then begin match mode with | EAString -> - set_field (EConst (String (fst field.cff_name,SDoubleQuotes)),null_pos) + set_field field ct (EConst (String (fst field.cff_name,SDoubleQuotes)),null_pos) | EAInt i -> - set_field (EConst (Int (string_of_int !i)),null_pos); + set_field field ct (EConst (Int (string_of_int !i)),null_pos); incr i; | EAOther -> error "Value required" field.cff_pos @@ -414,12 +433,12 @@ let build_enum_abstract ctx c a fields p = end | _ -> () end; - set_field e + set_field field ct e end | _ -> () ) fields; - EVars [("",null_pos),false,Some (CTAnonymous fields,p),None],p + EVars [mk_evar ~t:(CTAnonymous fields,p) ("",null_pos)],p let apply_macro ctx mode path el p = let cpath, meth = (match List.rev (ExtString.String.nsplit path ".") with @@ -429,8 +448,9 @@ let apply_macro ctx mode path el p = ctx.g.do_macro ctx mode cpath meth el p let build_module_def ctx mt meta fvars context_init fbuild = - let loop (f_build,f_enum) = function - | Meta.Build,args,p -> (fun () -> + let is_typedef = match mt with TTypeDecl _ -> true | _ -> false in + let loop f_build = function + | Meta.Build,args,p when not is_typedef -> (fun () -> let epath, el = (match args with | [ECall (epath,el),p] -> epath, el | _ -> error "Invalid build parameters" p @@ -445,19 +465,7 @@ let build_module_def ctx mt meta fvars context_init fbuild = (match r with | None -> error "Build failure" p | Some e -> fbuild e) - ) :: f_build,f_enum - | Meta.Enum,_,p -> f_build,Some (fun () -> - begin match mt with - | TClassDecl ({cl_kind = KAbstractImpl a} as c) -> - (* if p <> null_pos && not (Define.is_haxe3_compat ctx.com.defines) then - ctx.com.warning "`@:enum abstract` is deprecated in favor of `enum abstract`" p; *) - context_init#run; - let e = build_enum_abstract ctx c a (fvars()) p in - fbuild e; - | _ -> - () - end - ) + ) :: f_build | Meta.Using,el,p -> (fun () -> List.iter (fun e -> try @@ -472,23 +480,33 @@ let build_module_def ctx mt meta fvars context_init fbuild = with Exit -> error "dot path expected" (pos e) ) el; - ) :: f_build,f_enum + ) :: f_build | _ -> - f_build,f_enum + f_build in (* let errors go through to prevent resume if build fails *) - let f_build,f_enum = List.fold_left loop ([],None) meta in + let f_build = List.fold_left loop [] meta in (* Go for @:using in parents and interfaces *) - (match mt with + let f_enum = match mt with + | TClassDecl ({cl_kind = KAbstractImpl a} as c) when a.a_enum -> + Some (fun () -> + (* if p <> null_pos && not (Define.is_haxe3_compat ctx.com.defines) then + ctx.com.warning "`@:enum abstract` is deprecated in favor of `enum abstract`" p; *) + context_init#run; + let e = build_enum_abstract ctx c a (fvars()) a.a_name_pos in + fbuild e; + ) | TClassDecl { cl_super = csup; cl_implements = interfaces; cl_kind = kind } -> let ti = t_infos mt in let inherit_using (c,_) = ti.mt_using <- ti.mt_using @ (t_infos (TClassDecl c)).mt_using in Option.may inherit_using csup; - List.iter inherit_using interfaces - | _ -> () - ); + List.iter inherit_using interfaces; + None + | _ -> + None + in List.iter (fun f -> f()) (List.rev f_build); (match f_enum with None -> () | Some f -> f()) @@ -513,12 +531,13 @@ let create_class_context ctx c context_init p = on_error = (fun ctx msg ep -> ctx.com.error msg ep; (* macros expressions might reference other code, let's recall which class we are actually compiling *) - if !locate_macro_error && (ep.pfile <> c.cl_pos.pfile || ep.pmax < c.cl_pos.pmin || ep.pmin > c.cl_pos.pmax) then ctx.com.error "Defined in this class" c.cl_pos + let open TFunctions in + if not (ExtString.String.starts_with msg "...") && !locate_macro_error && (is_pos_outside_class c ep) && not (is_module_fields_class c) then ctx.com.error (compl_msg "Defined in this class") c.cl_pos ); } in (* a lib type will skip most checks *) let is_lib = Meta.has Meta.LibType c.cl_meta in - if is_lib && not c.cl_extern then ctx.com.error "@:libType can only be used in extern classes" c.cl_pos; + if is_lib && not (has_class_flag c CExtern) then ctx.com.error "@:libType can only be used in extern classes" c.cl_pos; (* a native type will skip one check: the static vs non-static field *) let is_native = Meta.has Meta.JavaNative c.cl_meta || Meta.has Meta.CsNative c.cl_meta in if Meta.has Meta.Macro c.cl_meta then display_error ctx "Macro classes are no longer allowed in haxe 3" c.cl_pos; @@ -538,20 +557,28 @@ let create_class_context ctx c context_init p = abstract = abstract; context_init = context_init; force_constructor = false; - uninitialized_final = None; + uninitialized_final = []; delayed_expr = []; has_display_field = false; } in ctx,cctx let create_field_context (ctx,cctx) c cff = + DeprecationCheck.check_is ctx.com (fst cff.cff_name) cff.cff_meta (snd cff.cff_name); let ctx = { ctx with pass = PBuildClass; (* will be set later to PTypeExpr *) + locals = PMap.empty; + opened = []; + monomorphs = { + perfunction = []; + }; } in let display_modifier = Typeload.check_field_access ctx cff in let is_static = List.mem_assoc AStatic cff.cff_access in + let is_static,is_abstract_member = if cctx.abstract <> None && not is_static then true,true else is_static,false in let is_extern = ref (List.mem_assoc AExtern cff.cff_access) in + let is_abstract = List.mem_assoc AAbstract cff.cff_access in let is_final = ref (List.mem_assoc AFinal cff.cff_access) in List.iter (fun (m,_,p) -> match m with @@ -566,12 +593,22 @@ let create_field_context (ctx,cctx) c cff = | _ -> () ) cff.cff_meta; - let allow_inline = cctx.abstract <> None || match cff.cff_kind with - | FFun _ -> ctx.g.doinline || !is_extern || c.cl_extern - | _ -> true - in - let is_inline = allow_inline && List.mem_assoc AInline cff.cff_access in + let is_inline = List.mem_assoc AInline cff.cff_access in + if (is_abstract && not (has_meta Meta.LibType c.cl_meta)) then begin + if is_static then + display_error ctx "Static methods may not be abstract" (pos cff.cff_name) + else if !is_final then + display_error ctx "Abstract methods may not be final" (pos cff.cff_name) + else if is_inline then + display_error ctx "Abstract methods may not be inline" (pos cff.cff_name) + else if not (has_class_flag c CAbstract) then begin + display_error ctx "This class should be declared abstract because it has at least one abstract field" c.cl_name_pos; + display_error ctx "First abstract field was here" (pos cff.cff_name); + add_class_flag c CAbstract; + end; + end; let override = try Some (List.assoc AOverride cff.cff_access) with Not_found -> None in + let overload = try Some (List.assoc AOverload cff.cff_access) with Not_found -> None in let is_macro = List.mem_assoc AMacro cff.cff_access in let field_kind = match fst cff.cff_name with | "new" -> FKConstructor @@ -582,15 +619,18 @@ let create_field_context (ctx,cctx) c cff = is_inline = is_inline; is_static = is_static; override = override; + overload = overload; is_macro = is_macro; is_extern = !is_extern; + is_abstract = is_abstract; is_final = !is_final; is_display_field = ctx.is_display_file && DisplayPosition.display_position#enclosed_in cff.cff_pos; is_field_debug = cctx.is_class_debug || Meta.has (Meta.Custom ":debug.typeload") cff.cff_meta; display_modifier = display_modifier; - is_abstract_member = cctx.abstract <> None && Meta.has Meta.Impl cff.cff_meta; + is_abstract_member = is_abstract_member; + is_generic = Meta.has Meta.Generic cff.cff_meta; field_kind = field_kind; - do_bind = (((not (c.cl_extern || !is_extern) || is_inline) && not c.cl_interface) || field_kind = FKInit); + do_bind = (((not ((has_class_flag c CExtern) || !is_extern) || is_inline) && not is_abstract && not (has_class_flag c CInterface)) || field_kind = FKInit); do_add = true; expr_presence_matters = false; } in @@ -605,7 +645,7 @@ let is_public (ctx,cctx) access parent = true else match parent with | Some cf -> (has_class_field_flag cf CfPublic) - | _ -> c.cl_extern || c.cl_interface || cctx.extends_public + | _ -> (has_class_flag c CExtern) || (has_class_flag c CInterface) || cctx.extends_public || (match c.cl_kind with KModuleFields _ -> true | _ -> false) let rec get_parent c name = match c.cl_super with @@ -616,28 +656,6 @@ let rec get_parent c name = with Not_found -> get_parent csup name -let add_field c cf = - let is_static = has_class_field_flag cf CfStatic in - if is_static then begin - c.cl_statics <- PMap.add cf.cf_name cf c.cl_statics; - c.cl_ordered_statics <- cf :: c.cl_ordered_statics; - end else begin - c.cl_fields <- PMap.add cf.cf_name cf c.cl_fields; - c.cl_ordered_fields <- cf :: c.cl_ordered_fields; - end - -let type_opt (ctx,cctx) p t = - let c = cctx.tclass in - match t with - | None when c.cl_extern || c.cl_interface -> - display_error ctx "Type required for extern classes and interfaces" p; - t_dynamic - | None when cctx.is_core_api -> - display_error ctx "Type required for core api classes" p; - t_dynamic - | _ -> - load_type_hint ctx p t - let transform_field (ctx,cctx) c f fields p = let f = match cctx.abstract with | Some a -> @@ -656,6 +674,19 @@ let transform_field (ctx,cctx) c f fields p = | _ -> ()); f +let type_var_field ctx t e stat do_display p = + if stat then ctx.curfun <- FunStatic else ctx.curfun <- FunMember; + let e = if do_display then Display.ExprPreprocessing.process_expr ctx.com e else e in + let e = type_expr ctx e (WithType.with_type t) in + let e = AbstractCast.cast_or_unify ctx t e p in + match t with + | TType ({ t_path = ([],"UInt") },[]) | TAbstract ({ a_path = ([],"UInt") },[]) when stat -> { e with etype = t } + | _ -> e + +let type_var_field ctx t e stat do_display p = + let save = TypeloadFunction.save_field_state ctx in + Std.finally save (type_var_field ctx t e stat do_display) p + let build_fields (ctx,cctx) c fields = let fields = ref fields in let get_fields() = !fields in @@ -663,7 +694,7 @@ let build_fields (ctx,cctx) c fields = c.cl_build <- (fun() -> BuildMacro pending); build_module_def ctx (TClassDecl c) c.cl_meta get_fields cctx.context_init (fun (e,p) -> match e with - | EVars [_,_,Some (CTAnonymous f,p),None] -> + | EVars [{ ev_type = Some (CTAnonymous f,p); ev_expr = None }] -> let f = List.map (fun f -> transform_field (ctx,cctx) c f fields p) f in fields := f | _ -> error "Class build macro must return a single variable with anonymous fields" p @@ -672,53 +703,11 @@ let build_fields (ctx,cctx) c fields = List.iter (fun f -> f()) !pending; !fields -let bind_type (ctx,cctx,fctx) cf r p = - let c = cctx.tclass in - let rec is_full_type t = - match t with - | TFun (args,ret) -> is_full_type ret && List.for_all (fun (_,_,t) -> is_full_type t) args - | TMono r -> (match r.tm_type with None -> false | Some t -> is_full_type t) - | TAbstract _ | TInst _ | TEnum _ | TLazy _ | TDynamic _ | TAnon _ | TType _ -> true - in - let force_macro () = - (* force macro system loading of this class in order to get completion *) - delay ctx PTypeField (fun() -> try ignore(ctx.g.do_macro ctx MDisplay c.cl_path cf.cf_name [] p) with Exit | Error _ -> ()) - in - let handle_display_field () = - if fctx.is_macro && not ctx.in_macro then - force_macro() - else begin - cf.cf_type <- TLazy r; - cctx.delayed_expr <- (ctx,Some r) :: cctx.delayed_expr; - end - in - if ctx.com.display.dms_full_typing then begin - if fctx.is_macro && not ctx.in_macro then - force_macro () - else begin - cf.cf_type <- TLazy r; - (* is_lib ? *) - cctx.delayed_expr <- (ctx,Some r) :: cctx.delayed_expr; - end - end else if ctx.com.display.dms_force_macro_typing && fctx.is_macro && not ctx.in_macro then - force_macro() - else begin - if fctx.is_display_field then begin - handle_display_field() - end else begin - if not (is_full_type cf.cf_type) then begin - cctx.delayed_expr <- (ctx, None) :: cctx.delayed_expr; - cf.cf_type <- TLazy r; - end else if fctx.expr_presence_matters then - cf.cf_expr <- Some (mk (TConst TNull) t_dynamic null_pos) - end - end - let check_field_display ctx fctx c cf = if fctx.is_display_field then begin let scope, cf = match c.cl_kind with | KAbstractImpl _ -> - if Meta.has Meta.Impl cf.cf_meta then + if has_class_field_flag cf CfImpl then (if cf.cf_name = "_new" then CFSConstructor, {cf with cf_name = "new"} else @@ -741,40 +730,82 @@ let check_field_display ctx fctx c cf = DisplayEmitter.check_field_modifiers ctx c cf fctx.override fctx.display_modifier; end -let bind_var (ctx,cctx,fctx) cf e = - let c = cctx.tclass in - let p = cf.cf_pos in - let rec get_declared f = function - | None -> None - | Some (c,a) when PMap.exists f c.cl_fields -> - Some (c,a) - | Some (c,_) -> - let ret = get_declared f c.cl_super in - match ret with - | Some r -> Some r - | None -> - let rec loop ifaces = match ifaces with - | [] -> None - | i :: ifaces -> match get_declared f (Some i) with - | Some r -> Some r - | None -> loop ifaces - in - loop c.cl_implements - in - if not fctx.is_static && not cctx.is_lib then begin match get_declared cf.cf_name c.cl_super with - | None -> () - | Some (csup,_) -> - (* this can happen on -net-lib generated classes if a combination of explicit interfaces and variables with the same name happens *) - if not (csup.cl_interface && Meta.has Meta.CsNative c.cl_meta) then - error ("Redefinition of variable " ^ cf.cf_name ^ " in subclass is not allowed. Previously declared at " ^ (s_type_path csup.cl_path) ) p - end; - let t = cf.cf_type in +module TypeBinding = struct - match e with - | None -> - check_field_display ctx fctx c cf; - | Some e -> - if c.cl_interface then display_error ctx "Default values on interfaces are not allowed" (pos e); + let bind_type ctx cctx fctx cf r p = + let c = cctx.tclass in + let rec is_full_type t = + match t with + | TFun (args,ret) -> is_full_type ret && List.for_all (fun (_,_,t) -> is_full_type t) args + | TMono r -> (match r.tm_type with None -> false | Some t -> is_full_type t) + | TAbstract _ | TInst _ | TEnum _ | TLazy _ | TDynamic _ | TAnon _ | TType _ -> true + in + let force_macro () = + (* force macro system loading of this class in order to get completion *) + delay ctx PTypeField (fun() -> try ignore(ctx.g.do_macro ctx MDisplay c.cl_path cf.cf_name [] p) with Exit | Error _ -> ()) + in + let handle_display_field () = + if fctx.is_macro && not ctx.in_macro then + force_macro() + else begin + cf.cf_type <- TLazy r; + cctx.delayed_expr <- (ctx,Some r) :: cctx.delayed_expr; + end + in + if ctx.com.display.dms_full_typing then begin + if fctx.is_macro && not ctx.in_macro then + force_macro () + else begin + cf.cf_type <- TLazy r; + (* is_lib ? *) + cctx.delayed_expr <- (ctx,Some r) :: cctx.delayed_expr; + end + end else if ctx.com.display.dms_force_macro_typing && fctx.is_macro && not ctx.in_macro then + force_macro() + else begin + if fctx.is_display_field then begin + handle_display_field() + end else begin + if not (is_full_type cf.cf_type) then begin + cctx.delayed_expr <- (ctx, None) :: cctx.delayed_expr; + cf.cf_type <- TLazy r; + end else if fctx.expr_presence_matters then + cf.cf_expr <- Some (mk (TConst TNull) t_dynamic null_pos) + end + end + + let check_redefinition ctx cctx fctx cf = + let c = cctx.tclass in + let rec get_declared f = function + | None -> None + | Some (c,a) when PMap.exists f c.cl_fields -> + Some (c,a) + | Some (c,_) -> + let ret = get_declared f c.cl_super in + match ret with + | Some r -> Some r + | None -> + let rec loop ifaces = match ifaces with + | [] -> None + | i :: ifaces -> match get_declared f (Some i) with + | Some r -> Some r + | None -> loop ifaces + in + loop c.cl_implements + in + if not fctx.is_static && not cctx.is_lib then begin match get_declared cf.cf_name c.cl_super with + | None -> () + | Some (csup,_) -> + (* this can happen on -net-lib generated classes if a combination of explicit interfaces and variables with the same name happens *) + if not ((has_class_flag csup CInterface) && Meta.has Meta.CsNative c.cl_meta) then + error ("Redefinition of variable " ^ cf.cf_name ^ " in subclass is not allowed. Previously declared at " ^ (s_type_path csup.cl_path) ) cf.cf_name_pos + end + + let bind_var_expression ctx cctx fctx cf e = + let c = cctx.tclass in + let t = cf.cf_type in + let p = cf.cf_pos in + if (has_class_flag c CInterface) then display_error ctx "Default values on interfaces are not allowed" (pos e); cf.cf_meta <- ((Meta.Value,[e],null_pos) :: cf.cf_meta); let check_cast e = (* insert cast to keep explicit field type (issue #1901) *) @@ -794,7 +825,7 @@ let bind_var (ctx,cctx,fctx) cf e = r := lazy_processing (fun() -> t); cctx.context_init#run; if ctx.com.verbose then Common.log ctx.com ("Typing " ^ (if ctx.in_macro then "macro " else "") ^ s_type_path c.cl_path ^ "." ^ cf.cf_name); - let e = TypeloadFunction.type_var_field ctx t e fctx.is_static fctx.is_display_field p in + let e = type_var_field ctx t e fctx.is_static fctx.is_display_field p in let maybe_run_analyzer e = match e.eexpr with | TConst _ | TLocal _ | TFunction _ -> e | _ -> !analyzer_run_on_expr_ref ctx.com e @@ -807,7 +838,7 @@ let bind_var (ctx,cctx,fctx) cf e = | None -> display_error ctx msg p; e in let e = (match cf.cf_kind with - | Var v when c.cl_extern || fctx.is_extern -> + | Var v when (has_class_flag c CExtern) || fctx.is_extern -> if not fctx.is_static then begin display_error ctx "Extern non-static variables may not be initialized" p; e @@ -844,8 +875,8 @@ let bind_var (ctx,cctx,fctx) cf e = | Var v when v.v_read = AccInline -> let e = require_constant_expression e "Inline variable initialization must be a constant value" in begin match c.cl_kind with - | KAbstractImpl a when Meta.has Meta.Enum cf.cf_meta && Meta.has Meta.Enum a.a_meta -> - unify ctx t (TAbstract(a,(List.map (fun _ -> mk_mono()) a.a_params))) p; + | KAbstractImpl a when has_class_field_flag cf CfEnum && a.a_enum -> + unify ctx t (TAbstract(a,(Monomorph.spawn_constrained_monos (fun t -> t) a.a_params))) p; let e1 = match e.eexpr with TCast(e1,None) -> e1 | _ -> e in unify ctx e1.etype a.a_this e1.epos | _ -> @@ -863,16 +894,81 @@ let bind_var (ctx,cctx,fctx) cf e = t ) "bind_var" in if not fctx.is_static then cctx.force_constructor <- true; - bind_type (ctx,cctx,fctx) cf r (snd e) + bind_type ctx cctx fctx cf r (snd e) + + let bind_var ctx cctx fctx cf e = + let c = cctx.tclass in + check_redefinition ctx cctx fctx cf; + match e with + | None -> + check_field_display ctx fctx c cf; + | Some e -> + bind_var_expression ctx cctx fctx cf e + + let bind_method ctx cctx fctx cf t args ret e p = + let c = cctx.tclass in + let bind r = + r := lazy_processing (fun() -> t); + cctx.context_init#run; + incr stats.s_methods_typed; + if ctx.com.verbose then Common.log ctx.com ("Typing " ^ (if ctx.in_macro then "macro " else "") ^ s_type_path c.cl_path ^ "." ^ cf.cf_name); + let fmode = (match cctx.abstract with + | Some _ -> + if fctx.is_abstract_member then FunMemberAbstract else FunStatic + | None -> + if fctx.field_kind = FKConstructor then FunConstructor else if fctx.is_static then FunStatic else FunMember + ) in + begin match ctx.com.platform with + | Java when is_java_native_function ctx cf.cf_meta cf.cf_pos -> + if e <> None then + ctx.com.warning "@:java.native function definitions shouldn't include an expression. This behaviour is deprecated." cf.cf_pos; + cf.cf_expr <- None; + cf.cf_type <- t + | _ -> + if Meta.has Meta.DisplayOverride cf.cf_meta then DisplayEmitter.check_field_modifiers ctx c cf fctx.override fctx.display_modifier; + let e = TypeloadFunction.type_function ctx args ret fmode e fctx.is_display_field p in + begin match fctx.field_kind with + | FKNormal when not fctx.is_static -> TypeloadCheck.check_overriding ctx c cf + | _ -> () + end; + (* Disabled for now, see https://github.com/HaxeFoundation/haxe/issues/3033 *) + (* List.iter (fun (v,_) -> + if v.v_name <> "_" && has_mono v.v_type then ctx.com.warning "Uninferred function argument, please add a type-hint" v.v_pos; + ) fargs; *) + let tf = { + tf_args = args#for_expr; + tf_type = ret; + tf_expr = e; + } in + if fctx.field_kind = FKInit then + (match e.eexpr with + | TBlock [] | TBlock [{ eexpr = TConst _ }] | TConst _ | TObjectDecl [] -> () + | _ -> c.cl_init <- Some e); + cf.cf_expr <- Some (mk (TFunction tf) t p); + cf.cf_type <- t; + check_field_display ctx fctx c cf; + end; + in + let maybe_bind r = + if not !return_partial_type then bind r; + t + in + let r = exc_protect ~force:false ctx maybe_bind "type_fun" in + bind_type ctx cctx fctx cf r p +end let create_variable (ctx,cctx,fctx) c f t eo p = - if not fctx.is_static && cctx.abstract <> None then error (fst f.cff_name ^ ": Cannot declare member variable in abstract") p; + let is_abstract_enum_field = Meta.has Meta.Enum f.cff_meta in + if fctx.is_abstract_member && not is_abstract_enum_field then error (fst f.cff_name ^ ": Cannot declare member variable in abstract") p; if fctx.is_inline && not fctx.is_static then error (fst f.cff_name ^ ": Inline variable must be static") p; if fctx.is_inline && eo = None then error (fst f.cff_name ^ ": Inline variable must be initialized") p; - if fctx.is_final && not (fctx.is_extern || c.cl_extern || c.cl_interface) && eo = None then begin - if fctx.is_static then error (fst f.cff_name ^ ": Static final variable must be initialized") p - else cctx.uninitialized_final <- Some f.cff_pos; - end; + let missing_initialization = + fctx.is_final + && not (fctx.is_extern || (has_class_flag c CExtern) || (has_class_flag c CInterface)) + && eo = None + in + if missing_initialization && fctx.is_static && fctx.is_final then + error (fst f.cff_name ^ ": Static final variable must be initialized") p; let t = (match t with | None when eo = None -> error ("Variable requires type-hint or initialization") (pos f.cff_name); @@ -894,19 +990,32 @@ let create_variable (ctx,cctx,fctx) c f t eo p = cf_meta = f.cff_meta; cf_kind = Var kind; } in - if fctx.is_final then add_class_field_flag cf CfFinal; + if fctx.is_final then begin + if missing_initialization && not fctx.is_static then + cctx.uninitialized_final <- cf :: cctx.uninitialized_final; + add_class_field_flag cf CfFinal; + end; if fctx.is_extern then add_class_field_flag cf CfExtern; + if fctx.is_abstract_member then begin + cf.cf_meta <- ((Meta.Custom ":impl"),[],null_pos) :: cf.cf_meta; + add_class_field_flag cf CfImpl; + end; + if is_abstract_enum_field then add_class_field_flag cf CfEnum; ctx.curfield <- cf; - bind_var (ctx,cctx,fctx) cf eo; + TypeBinding.bind_var ctx cctx fctx cf eo; cf let check_abstract (ctx,cctx,fctx) c cf fd t ret p = match cctx.abstract with | Some a -> let m = mk_mono() in - let ta = TAbstract(a, List.map (fun _ -> mk_mono()) a.a_params) in + let ta = TAbstract(a,List.map (fun _ -> mk_mono()) a.a_params) in let tthis = if fctx.is_abstract_member || Meta.has Meta.To cf.cf_meta then monomorphs a.a_params a.a_this else a.a_this in let allows_no_expr = ref (Meta.has Meta.CoreType a.a_meta) in + let allow_no_expr () = if not (has_class_field_flag cf CfExtern) then begin + allows_no_expr := true; + fctx.expr_presence_matters <- true; + end in let rec loop ml = (match ml with | (Meta.From,_,_) :: _ -> @@ -933,7 +1042,7 @@ let check_abstract (ctx,cctx,fctx) c cf fd t ret p = | _ -> () ); (* TODO: this doesn't seem quite right... *) - if not (Meta.has Meta.Impl cf.cf_meta) then cf.cf_meta <- (Meta.Impl,[],null_pos) :: cf.cf_meta; + if not (has_class_field_flag cf CfImpl) then add_class_field_flag cf CfImpl; let resolve_m args = (try unify_raise ctx t (tfun (tthis :: args) m) cf.cf_pos with Error (Unify l,p) -> error (error_msg (Unify l)) p); match follow m with @@ -964,9 +1073,11 @@ let check_abstract (ctx,cctx,fctx) c cf fd t ret p = | ((Meta.ArrayAccess,_,_) | (Meta.Op,[(EArrayDecl _),_],_)) :: _ -> if fctx.is_macro then error (cf.cf_name ^ ": Macro array-access functions are not supported") p; a.a_array <- cf :: a.a_array; - fctx.expr_presence_matters <- true; + allow_no_expr(); | (Meta.Op,[EBinop(OpAssign,_,_),_],_) :: _ -> error (cf.cf_name ^ ": Assignment overloading is not supported") p; + | (Meta.Op,[ETernary(_,_,_),_],_) :: _ -> + error (cf.cf_name ^ ": Ternary overloading is not supported") p; | (Meta.Op,[EBinop(op,_,_),_],_) :: _ -> if fctx.is_macro then error (cf.cf_name ^ ": Macro operator functions are not supported") p; let targ = if fctx.is_abstract_member then tthis else ta in @@ -982,22 +1093,13 @@ let check_abstract (ctx,cctx,fctx) c cf fd t ret p = if not (left_eq || right_eq) then error (cf.cf_name ^ ": The left or right argument type must be " ^ (s_type (print_context()) targ)) cf.cf_pos; if right_eq && Meta.has Meta.Commutative cf.cf_meta then error (cf.cf_name ^ ": @:commutative is only allowed if the right argument is not " ^ (s_type (print_context()) targ)) cf.cf_pos; a.a_ops <- (op,cf) :: a.a_ops; - allows_no_expr := true; - fctx.expr_presence_matters <- true; + allow_no_expr(); | (Meta.Op,[EUnop(op,flag,_),_],_) :: _ -> if fctx.is_macro then error (cf.cf_name ^ ": Macro operator functions are not supported") p; let targ = if fctx.is_abstract_member then tthis else ta in (try type_eq EqStrict t (tfun [targ] (mk_mono())) with Unify_error l -> raise (Error ((Unify l),cf.cf_pos))); a.a_unops <- (op,flag,cf) :: a.a_unops; - allows_no_expr := true; - fctx.expr_presence_matters <- true; - | (Meta.Impl,_,_) :: ml when cf.cf_name <> "_new" && not fctx.is_macro -> - begin match follow t with - | TFun((_,_,t1) :: _, _) when type_iseq tthis t1 -> - () - | _ -> - display_error ctx ("First argument of implementation function must be " ^ (s_type (print_context()) tthis)) cf.cf_pos - end; + allow_no_expr(); | ((Meta.Resolve,_,_) | (Meta.Op,[EField _,_],_)) :: _ -> let targ = if fctx.is_abstract_member then tthis else ta in let check_fun t1 t2 = @@ -1024,26 +1126,22 @@ let check_abstract (ctx,cctx,fctx) c cf fd t ret p = | [] -> () in loop cf.cf_meta; - let check_bind () = - if fd.f_expr = None then begin - if fctx.is_inline then error (cf.cf_name ^ ": Inline functions must have an expression") cf.cf_pos; - begin match fd.f_type with - | None -> error (cf.cf_name ^ ": Functions without expressions must have an explicit return type") cf.cf_pos - | Some _ -> () - end; + if cf.cf_name = "_new" && Meta.has Meta.MultiType a.a_meta then fctx.do_bind <- false; + if fd.f_expr = None then begin + if fctx.is_inline then error (cf.cf_name ^ ": Inline functions must have an expression") cf.cf_pos; + if fd.f_type = None then error (cf.cf_name ^ ": Functions without expressions must have an explicit return type") cf.cf_pos; + if !allows_no_expr then begin cf.cf_meta <- (Meta.NoExpr,[],null_pos) :: cf.cf_meta; fctx.do_bind <- false; if not (Meta.has Meta.CoreType a.a_meta) then fctx.do_add <- false; end - in - if cf.cf_name = "_new" && Meta.has Meta.MultiType a.a_meta then fctx.do_bind <- false; - if !allows_no_expr then check_bind() + end | _ -> () let create_method (ctx,cctx,fctx) c f fd p = let params = TypeloadFunction.type_function_params ctx fd (fst f.cff_name) p in - if Meta.has Meta.Generic f.cff_meta then begin + if fctx.is_generic then begin if params = [] then error (fst f.cff_name ^ ": Generic functions must have type parameters") p; end; let fd = if fctx.is_macro && not ctx.in_macro && not fctx.is_static then @@ -1057,7 +1155,7 @@ let create_method (ctx,cctx,fctx) c f fd p = else begin if ctx.in_macro then begin (* a class with a macro cannot be extern in macro context (issue #2015) *) - c.cl_extern <- false; + remove_class_flag c CExtern; let texpr = CTPath (mk_type_path (["haxe";"macro"],"Expr")) in (* ExprOf type parameter might contain platform-specific type, let's replace it by Expr *) let no_expr_of (t,p) = match t with @@ -1086,12 +1184,12 @@ let create_method (ctx,cctx,fctx) c f fd p = f_expr = None; } end in - begin match c.cl_interface,fctx.field_kind with + begin match (has_class_flag c CInterface),fctx.field_kind with | true,FKConstructor -> error "An interface cannot have a constructor" p; | true,_ -> if not fctx.is_static && fd.f_expr <> None then error (fst f.cff_name ^ ": An interface method cannot have a body") p; - if fctx.is_inline && c.cl_interface then error (fst f.cff_name ^ ": You can't declare inline methods in interfaces") p; + if fctx.is_inline && (has_class_flag c CInterface) then error (fst f.cff_name ^ ": You can't declare inline methods in interfaces") p; | false,FKConstructor -> if fctx.is_static then error "A constructor must not be static" p; begin match fd.f_type with @@ -1106,32 +1204,24 @@ let create_method (ctx,cctx,fctx) c f fd p = end; let parent = (if not fctx.is_static then get_parent c (fst f.cff_name) else None) in let dynamic = List.mem_assoc ADynamic f.cff_access || (match parent with Some { cf_kind = Method MethDynamic } -> true | _ -> false) in + if fctx.is_abstract && dynamic then display_error ctx "Abstract methods may not be dynamic" p; if fctx.is_inline && dynamic then error (fst f.cff_name ^ ": 'inline' is not allowed on 'dynamic' functions") p; let is_override = Option.is_some fctx.override in if (is_override && fctx.is_static) then error (fst f.cff_name ^ ": 'override' is not allowed on 'static' functions") p; ctx.type_params <- if fctx.is_static && not fctx.is_abstract_member then params else params @ ctx.type_params; (* TODO is_lib: avoid forcing the return type to be typed *) - let ret = if fctx.field_kind = FKConstructor then ctx.t.tvoid else type_opt (ctx,cctx) p fd.f_type in - let rec loop args = match args with - | ((name,p),opt,m,t,ct) :: args -> - (* TODO is_lib: avoid forcing the field to be typed *) - let t, ct = TypeloadFunction.type_function_arg ctx (type_opt (ctx,cctx) p t) ct opt p in - delay ctx PTypeField (fun() -> match follow t with - | TAbstract({a_path = ["haxe";"extern"],"Rest"},_) -> - if not fctx.is_extern && not c.cl_extern then error "Rest argument are only supported for extern methods" p; - if opt then error "Rest argument cannot be optional" p; - begin match ct with None -> () | Some (_,p) -> error "Rest argument cannot have default value" p end; - if args <> [] then error "Rest should only be used for the last function argument" p; - | _ -> - () - ); - (name, ct, t) :: (loop args) - | [] -> - [] + let ret = if fctx.field_kind = FKConstructor then ctx.t.tvoid else FunctionArguments.type_opt ctx cctx.is_core_api fctx.is_abstract p fd.f_type in + let abstract_this = match cctx.abstract with + | Some a when fctx.is_abstract_member && fst f.cff_name <> "_new" (* TODO: this sucks *) && not fctx.is_macro -> + Some a.a_this + | _ -> + None in - let args = loop fd.f_args in - let t = TFun (fun_args args,ret) in + let is_extern = fctx.is_extern || has_class_flag ctx.curclass CExtern in + let type_arg opt t p = FunctionArguments.type_opt ctx cctx.is_core_api fctx.is_abstract p t in + let args = new FunctionArguments.function_arguments ctx type_arg is_extern fctx.is_display_field abstract_this fd.f_args in + let t = TFun (args#for_type,ret) in let cf = { (mk_field (fst f.cff_name) ~public:(is_public (ctx,cctx) f.cff_access parent) t f.cff_pos (pos f.cff_name)) with cf_doc = f.cff_doc; @@ -1141,6 +1231,23 @@ let create_method (ctx,cctx,fctx) c f fd p = } in if fctx.is_final then add_class_field_flag cf CfFinal; if fctx.is_extern then add_class_field_flag cf CfExtern; + if fctx.is_abstract then add_class_field_flag cf CfAbstract; + if fctx.is_abstract_member then add_class_field_flag cf CfImpl; + if fctx.is_generic then add_class_field_flag cf CfGeneric; + begin match fctx.overload with + | Some p -> + if ctx.com.config.pf_overload then + add_class_field_flag cf CfOverload + else if fctx.field_kind = FKConstructor then + display_error ctx "Constructors cannot be overloaded on this target" p + else begin + add_class_field_flag cf CfOverload; + if not (has_class_flag c CExtern || fctx.is_extern) then + display_error ctx "Only extern functions may be overloaded on this target" p + end + | None -> + () + end; cf.cf_meta <- List.map (fun (m,el,p) -> match m,el with | Meta.AstSource,[] -> (m,(match fd.f_expr with None -> [] | Some e -> [e]),p) | _ -> m,el,p @@ -1157,74 +1264,21 @@ let create_method (ctx,cctx,fctx) c f fd p = check_abstract (ctx,cctx,fctx) c cf fd t ret p; init_meta_overloads ctx (Some c) cf; ctx.curfield <- cf; - let r = exc_protect ~force:false ctx (fun r -> - if not !return_partial_type then begin - r := lazy_processing (fun() -> t); - cctx.context_init#run; - incr stats.s_methods_typed; - if ctx.com.verbose then Common.log ctx.com ("Typing " ^ (if ctx.in_macro then "macro " else "") ^ s_type_path c.cl_path ^ "." ^ fst f.cff_name); - let fmode = (match cctx.abstract with - | Some _ -> - (match args with - | ("this",_,_) :: _ -> FunMemberAbstract - | _ when fst f.cff_name = "_new" -> FunMemberAbstract - | _ -> FunStatic) - | None -> - if fctx.field_kind = FKConstructor then FunConstructor else if fctx.is_static then FunStatic else FunMember - ) in - begin match ctx.com.platform with - | Java when is_java_native_function ctx cf.cf_meta cf.cf_pos -> - if fd.f_expr <> None then - ctx.com.warning "@:java.native function definitions shouldn't include an expression. This behaviour is deprecated." cf.cf_pos; - cf.cf_expr <- None; - cf.cf_type <- t - | _ -> - if Meta.has Meta.DisplayOverride cf.cf_meta then DisplayEmitter.check_field_modifiers ctx c cf fctx.override fctx.display_modifier; - let e , fargs = TypeloadFunction.type_function ctx args ret fmode fd fctx.is_display_field p in - begin match fctx.field_kind with - | FKNormal when not fctx.is_static -> TypeloadCheck.check_overriding ctx c cf - | _ -> () - end; - (* Disabled for now, see https://github.com/HaxeFoundation/haxe/issues/3033 *) - (* List.iter (fun (v,_) -> - if v.v_name <> "_" && has_mono v.v_type then ctx.com.warning "Uninferred function argument, please add a type-hint" v.v_pos; - ) fargs; *) - let tf = { - tf_args = fargs; - tf_type = ret; - tf_expr = e; - } in - if fctx.field_kind = FKInit then - (match e.eexpr with - | TBlock [] | TBlock [{ eexpr = TConst _ }] | TConst _ | TObjectDecl [] -> () - | _ -> c.cl_init <- Some e); - cf.cf_expr <- Some (mk (TFunction tf) t p); - cf.cf_type <- t; - check_field_display ctx fctx c cf; - end; - end; - t - ) "type_fun" in if fctx.do_bind then - bind_type (ctx,cctx,fctx) cf r (match fd.f_expr with Some e -> snd e | None -> f.cff_pos) + TypeBinding.bind_method ctx cctx fctx cf t args ret fd.f_expr (match fd.f_expr with Some e -> snd e | None -> f.cff_pos) else begin - delay ctx PTypeField (fun () -> - (* We never enter type_function so we're missing out on the argument processing there. Let's do it here. *) - List.iter2 (fun (n,ct,t) ((_,pn),_,m,_,_) -> - (* dirty dodge to avoid flash extern problems until somebody fixes that *) - begin if ctx.com.platform = Flash && c.cl_extern then - () - else - ignore(TypeloadFunction.process_function_arg ctx n t ct fctx.is_display_field pn) - end; - if fctx.is_display_field && DisplayPosition.display_position#enclosed_in pn then begin - let v = add_local_with_origin ctx TVOArgument n t pn in - DisplayEmitter.display_variable ctx v pn; - end - ) args fd.f_args; - ); - check_field_display ctx fctx c cf; - if fd.f_expr <> None && not (fctx.is_inline || fctx.is_macro) then ctx.com.warning "Extern non-inline function may not have an expression" p; + if fctx.is_display_field then begin + delay ctx PTypeField (fun () -> + (* We never enter type_function so we're missing out on the argument processing there. Let's do it here. *) + ignore(args#for_expr) + ); + check_field_display ctx fctx c cf; + end else + delay ctx PTypeField (fun () -> args#verify_extern); + if fd.f_expr <> None then begin + if fctx.is_abstract then display_error ctx "Abstract methods may not have an expression" p + else if not (fctx.is_inline || fctx.is_macro) then ctx.com.warning "Extern non-inline function may not have an expression" p; + end; end; cf @@ -1244,63 +1298,80 @@ let create_property (ctx,cctx,fctx) c f (get,set,t,eo) p = | _ -> tfun [] ret, TFun(["value",false,ret],ret) in let find_accessor m = - (* on pf_overload platforms, the getter/setter may have been defined as an overloaded function; get all overloads *) - if ctx.com.config.pf_overload then - if fctx.is_static then - let f = PMap.find m c.cl_statics in - (f.cf_type, f) :: (List.map (fun f -> f.cf_type, f) f.cf_overloads) - else - Overloads.get_overloads c m - else - [ if fctx.is_static then - let f = PMap.find m c.cl_statics in - f.cf_type, f - else match class_field c (List.map snd c.cl_params) m with - | _, t,f -> t,f ] + if fctx.is_static then begin + let cf = PMap.find m c.cl_statics in + (cf.cf_type,cf) :: (List.map (fun cf -> cf.cf_type,cf) cf.cf_overloads) + end else + Overloads.get_overloads ctx.com c m in - let check_method m t = - if ctx.com.display.dms_error_policy = EPIgnore then () else - try + let cf = { + (mk_field name ~public:(is_public (ctx,cctx) f.cff_access None) ret f.cff_pos (pos f.cff_name)) with + cf_doc = f.cff_doc; + cf_meta = f.cff_meta; + } in + if fctx.is_abstract_member then add_class_field_flag cf CfImpl; + let check_method m t is_getter = + if ctx.com.display.dms_error_policy = EPIgnore then + () + else try let overloads = find_accessor m in - (* choose the correct overload if and only if there is more than one overload found *) let rec get_overload overl = match overl with - | [tf] -> tf + | [tf] -> + tf | (t2,f2) :: overl -> if type_iseq t t2 then (t2,f2) else get_overload overl | [] -> - if c.cl_interface then - raise Not_found - else - raise (Error (Custom - (Printf.sprintf "No overloaded method named %s was compatible with the property %s with expected type %s" m (name) (s_type (print_context()) t) - ), p)) + raise Not_found in let t2, f2 = get_overload overloads in - (match f2.cf_kind with - | Method MethMacro -> - display_error ctx (f2.cf_name ^ ": Macro methods cannot be used as property accessor") p; - display_error ctx (f2.cf_name ^ ": Accessor method is here") f2.cf_pos; - | _ -> ()); - unify_raise ctx t2 t f2.cf_pos; - if (fctx.is_abstract_member && not (Meta.has Meta.Impl f2.cf_meta)) || (Meta.has Meta.Impl f2.cf_meta && not (fctx.is_abstract_member)) then - display_error ctx "Mixing abstract implementation and static properties/accessors is not allowed" f2.cf_pos; f2.cf_meta <- List.fold_left (fun acc ((m,_,_) as meta) -> match m with | Meta.Deprecated -> meta :: acc | _ -> acc ) f2.cf_meta f.cff_meta; + (* Now that we know there is a field, we have to delay the actual unification even further. The reason is that unification could resolve + TLazy, which would then cause field typing before we're done with our PConnectField pass. This could cause interface fields to not + be generated in time. *) + delay ctx PForce (fun () -> + try + (match f2.cf_kind with + | Method MethMacro -> + display_error ctx (f2.cf_name ^ ": Macro methods cannot be used as property accessor") p; + display_error ctx (compl_msg (f2.cf_name ^ ": Accessor method is here")) f2.cf_pos; + | _ -> ()); + unify_raise ctx t2 t f2.cf_pos; + if (fctx.is_abstract_member && not (has_class_field_flag f2 CfImpl)) || (has_class_field_flag f2 CfImpl && not (fctx.is_abstract_member)) then + display_error ctx "Mixing abstract implementation and static properties/accessors is not allowed" f2.cf_pos; + with Error (Unify l,p) -> + raise (Error (Stack (Custom ("In method " ^ m ^ " required by property " ^ name),Unify l),p)) + ) with - | Error (Unify l,p) -> raise (Error (Stack (Custom ("In method " ^ m ^ " required by property " ^ name),Unify l),p)) | Not_found -> - if c.cl_interface then begin + let generate_field () = let cf = mk_field m t p null_pos in cf.cf_meta <- [Meta.CompilerGenerated,[],null_pos;Meta.NoCompletion,[],null_pos]; cf.cf_kind <- Method MethNormal; + cf + in + if (has_class_flag c CInterface) then begin + let cf = generate_field () in c.cl_fields <- PMap.add cf.cf_name cf c.cl_fields; c.cl_ordered_fields <- cf :: c.cl_ordered_fields; - end else if not c.cl_extern then begin + end else if Diagnostics.is_diagnostics_run ctx.com f.cff_pos then begin + let cf_accessor = generate_field() in + remove_class_field_flag cf_accessor CfPublic; + if fctx.is_static then add_class_field_flag cf_accessor CfStatic; + let diag = { + mf_pos = (pos f.cff_name); + mf_on = TClassDecl c; + mf_fields = [(cf_accessor,t,CompletionItem.CompletionType.from_type (Display.get_import_status ctx) t)]; + mf_cause = PropertyAccessor(cf,is_getter); + } in + let display = ctx.com.display_information in + display.module_diagnostics <- MissingFields diag :: display.module_diagnostics + end else if not (has_class_flag c CExtern) then begin try let _, _, f2 = (if not fctx.is_static then let f = PMap.find m c.cl_statics in None, f.cf_type, f else class_field c (List.map snd c.cl_params) m) in display_error ctx (Printf.sprintf "Method %s is no valid accessor for %s because it is %sstatic" m (name) (if fctx.is_static then "not " else "")) f2.cf_pos @@ -1324,7 +1395,7 @@ let create_property (ctx,cctx,fctx) c f (get,set,t,eo) p = | "get",pget -> let get = "get_" ^ name in if fctx.is_display_field && DisplayPosition.display_position#enclosed_in pget then delay ctx PConnectField (fun () -> display_accessor get pget); - if not cctx.is_lib then delay_check (fun() -> check_method get t_get); + if not cctx.is_lib then delay_check (fun() -> check_method get t_get true); AccCall | _,pget -> display_error ctx (name ^ ": Custom property accessor is no longer supported, please use `get`") pget; @@ -1333,7 +1404,7 @@ let create_property (ctx,cctx,fctx) c f (get,set,t,eo) p = let set = (match set with | "null",_ -> (* standard flash library read-only variables can't be accessed for writing, even in subclasses *) - if c.cl_extern && (match c.cl_path with "flash" :: _ , _ -> true | _ -> false) && ctx.com.platform = Flash then + if (has_class_flag c CExtern) && (match c.cl_path with "flash" :: _ , _ -> true | _ -> false) && ctx.com.platform = Flash then AccNever else AccNo @@ -1343,29 +1414,25 @@ let create_property (ctx,cctx,fctx) c f (get,set,t,eo) p = | "set",pset -> let set = "set_" ^ name in if fctx.is_display_field && DisplayPosition.display_position#enclosed_in pset then delay ctx PConnectField (fun () -> display_accessor set pset); - if not cctx.is_lib then delay_check (fun() -> check_method set t_set); + if not cctx.is_lib then delay_check (fun() -> check_method set t_set false); AccCall | _,pset -> display_error ctx (name ^ ": Custom property accessor is no longer supported, please use `set`") pset; AccCall ) in if (set = AccNever && get = AccNever) then error (name ^ ": Unsupported property combination") p; - let cf = { - (mk_field name ~public:(is_public (ctx,cctx) f.cff_access None) ret f.cff_pos (pos f.cff_name)) with - cf_doc = f.cff_doc; - cf_meta = f.cff_meta; - cf_kind = Var { v_read = get; v_write = set }; - } in + cf.cf_kind <- Var { v_read = get; v_write = set }; if fctx.is_extern then add_class_field_flag cf CfExtern; + if Meta.has Meta.Enum cf.cf_meta then add_class_field_flag cf CfEnum; ctx.curfield <- cf; - bind_var (ctx,cctx,fctx) cf eo; + TypeBinding.bind_var ctx cctx fctx cf eo; cf (** Emit compilation error on `final static function` *) let reject_final_static_method ctx cctx fctx f = - if fctx.is_static && fctx.is_final && not cctx.tclass.cl_extern then + if fctx.is_static && fctx.is_final && not (has_class_flag cctx.tclass CExtern) then let p = try snd (List.find (fun (a,p) -> a = AFinal) f.cff_access) with Not_found -> @@ -1381,11 +1448,11 @@ let init_field (ctx,cctx,fctx) f = let name = fst f.cff_name in TypeloadCheck.check_global_metadata ctx f.cff_meta (fun m -> f.cff_meta <- m :: f.cff_meta) c.cl_module.m_path c.cl_path (Some name); let p = f.cff_pos in - if not c.cl_extern && not (Meta.has Meta.Native f.cff_meta) then Typecore.check_field_name ctx name p; + if not (has_class_flag c CExtern) && not (Meta.has Meta.Native f.cff_meta) then Typecore.check_field_name ctx name p; List.iter (fun acc -> match (fst acc, f.cff_kind) with | APublic, _ | APrivate, _ | AStatic, _ | AFinal, _ | AExtern, _ -> () - | ADynamic, FFun _ | AOverride, FFun _ | AMacro, FFun _ | AInline, FFun _ | AInline, FVar _ -> () + | ADynamic, FFun _ | AOverride, FFun _ | AMacro, FFun _ | AInline, FFun _ | AInline, FVar _ | AAbstract, FFun _ | AOverload, FFun _ -> () | _, FVar _ -> display_error ctx ("Invalid accessor '" ^ Ast.s_placed_access acc ^ "' for variable " ^ name) (snd acc) | _, FProp _ -> display_error ctx ("Invalid accessor '" ^ Ast.s_placed_access acc ^ "' for property " ^ name) (snd acc) ) f.cff_access; @@ -1406,7 +1473,7 @@ let init_field (ctx,cctx,fctx) f = | Some a when fctx.is_abstract_member -> ctx.type_params <- a.a_params; | _ -> () end; - let cf = + let cf = match f.cff_kind with | FVar (t,e) -> create_variable (ctx,cctx,fctx) c f t e p @@ -1417,6 +1484,8 @@ let init_field (ctx,cctx,fctx) f = create_property (ctx,cctx,fctx) c f (get,set,t,eo) p in (if (fctx.is_static || fctx.is_macro && ctx.in_macro) then add_class_field_flag cf CfStatic); + if Meta.has Meta.InheritDoc cf.cf_meta then + delay ctx PTypeField (fun() -> InheritDoc.build_class_field_doc ctx (Some c) cf); cf let check_overload ctx f fs = @@ -1424,33 +1493,43 @@ let check_overload ctx f fs = let f2 = List.find (fun f2 -> f != f2 && - Overloads.compare_overload_args ~ctx f.cf_type f2.cf_type f f2 = Overloads.Same + Overloads.same_overload_args f.cf_type f2.cf_type f f2 ) fs in display_error ctx ("Another overloaded field of same signature was already declared : " ^ f.cf_name) f.cf_pos; - display_error ctx ("The second field is declared here") f2.cf_pos + display_error ctx (compl_msg "The second field is declared here") f2.cf_pos; + false + with Not_found -> try + (* OVERLOADTODO: generalize this and respect whether or not we actually generate the functions *) + if ctx.com.platform <> Java then raise Not_found; + let get_vmtype = ambiguate_funs in + let f2 = + List.find (fun f2 -> + f != f2 && + Overloads.same_overload_args ~get_vmtype f.cf_type f2.cf_type f f2 + ) fs + in + display_error ctx ( + "Another overloaded field of similar signature was already declared : " ^ + f.cf_name ^ + "\nThe signatures are different in Haxe, but not in the target language" + ) f.cf_pos; + display_error ctx (compl_msg "The second field is declared here") f2.cf_pos; + false with Not_found -> - try - let f2 = - List.find (fun f2 -> - f != f2 && - Overloads.compare_overload_args ~ctx f.cf_type f2.cf_type f f2 = Overloads.Impl_conflict - ) fs - in - display_error ctx ( - "Another overloaded field of similar signature was already declared : " ^ - f.cf_name ^ - "\nThe signatures are different in Haxe, but not in the target language" - ) f.cf_pos; - display_error ctx ("The second field is declared here") f2.cf_pos - with | Not_found -> () + true let check_overloads ctx c = (* check if field with same signature was declared more than once *) - List.iter (fun f -> - if Meta.has Meta.Overload f.cf_meta then - check_overload ctx f (f :: f.cf_overloads) - ) (c.cl_ordered_fields @ c.cl_ordered_statics) + let check_field f = + if has_class_field_flag f CfOverload then begin + let all = f :: f.cf_overloads in + ignore(List.fold_left (fun b f -> b && check_overload ctx f all) true all) + end + in + List.iter check_field c.cl_ordered_fields; + List.iter check_field c.cl_ordered_statics; + Option.may check_field c.cl_constructor let init_class ctx c p context_init herits fields = let ctx,cctx = create_class_context ctx c context_init p in @@ -1459,7 +1538,14 @@ let init_class ctx c p context_init herits fields = let fields = build_fields (ctx,cctx) c fields in if cctx.is_core_api && ctx.com.display.dms_check_core_api then delay ctx PForce (fun() -> init_core_api ctx c); if not cctx.is_lib then begin - if ctx.com.config.pf_overload then delay ctx PForce (fun() -> check_overloads ctx c) + delay ctx PForce (fun() -> check_overloads ctx c); + begin match c.cl_super with + | Some(csup,tl) -> + if (has_class_flag csup CAbstract) && not (has_class_flag c CAbstract) then + delay ctx PForce (fun () -> TypeloadCheck.Inheritance.check_abstract_class ctx c csup tl); + | None -> + () + end end; let rec has_field f = function | None -> false @@ -1507,8 +1593,8 @@ let init_class ctx c p context_init herits fields = has_init := true end; if fctx.is_field_debug then print_endline ("Created field: " ^ Printer.s_tclass_field "" cf); - if fctx.is_static && c.cl_interface && fctx.field_kind <> FKInit && not cctx.is_lib && not (c.cl_extern) then - error "You can't declare static fields in interfaces" p; + if fctx.is_static && (has_class_flag c CInterface) && fctx.field_kind <> FKInit && not cctx.is_lib && not ((has_class_flag c CExtern)) then + error "You can only declare static fields in extern interfaces" p; let set_feature s = ctx.m.curmod.m_extra.m_if_feature <- (s,(c,cf,fctx.is_static)) :: ctx.m.curmod.m_extra.m_if_feature in @@ -1522,7 +1608,7 @@ let init_class ctx c p context_init herits fields = begin match fctx.field_kind with | FKConstructor -> begin match c.cl_super with - | Some ({ cl_extern = false; cl_constructor = Some ctor_sup }, _) when has_class_field_flag ctor_sup CfFinal -> + | Some ({ cl_constructor = Some ctor_sup } as c, _) when not (has_class_flag c CExtern) && has_class_field_flag ctor_sup CfFinal -> ctx.com.error "Cannot override final constructor" cf.cf_pos | _ -> () end; @@ -1530,10 +1616,10 @@ let init_class ctx c p context_init herits fields = | None -> c.cl_constructor <- Some cf | Some ctor when ctx.com.config.pf_overload -> - if Meta.has Meta.Overload cf.cf_meta && Meta.has Meta.Overload ctor.cf_meta then - ctor.cf_overloads <- cf :: ctor.cf_overloads - else - display_error ctx ("If using overloaded constructors, all constructors must be declared with @:overload") (if Meta.has Meta.Overload cf.cf_meta then ctor.cf_pos else cf.cf_pos) + if has_class_field_flag cf CfOverload && has_class_field_flag ctor CfOverload then + ctor.cf_overloads <- cf :: ctor.cf_overloads + else + display_error ctx ("If using overloaded constructors, all constructors must be declared with 'overload'") (if has_class_field_flag cf CfOverload then ctor.cf_pos else cf.cf_pos) | Some ctor -> display_error ctx "Duplicate constructor" p end @@ -1541,23 +1627,25 @@ let init_class ctx c p context_init herits fields = () | FKNormal -> let dup = if fctx.is_static then PMap.exists cf.cf_name c.cl_fields || has_field cf.cf_name c.cl_super else PMap.exists cf.cf_name c.cl_statics in - if not cctx.is_native && not c.cl_extern && dup then error ("Same field name can't be used for both static and instance : " ^ cf.cf_name) p; - if fctx.override <> None then c.cl_overrides <- cf :: c.cl_overrides; + if not cctx.is_native && not (has_class_flag c CExtern) && dup then error ("Same field name can't be used for both static and instance : " ^ cf.cf_name) p; + if fctx.override <> None then + add_class_field_flag cf CfOverride; let is_var cf = match cf.cf_kind with | Var _ -> true | _ -> false in if PMap.mem cf.cf_name (if fctx.is_static then c.cl_statics else c.cl_fields) then - if ctx.com.config.pf_overload && Meta.has Meta.Overload cf.cf_meta && not (is_var cf) then + if has_class_field_flag cf CfOverload && not (is_var cf) then let mainf = PMap.find cf.cf_name (if fctx.is_static then c.cl_statics else c.cl_fields) in if is_var mainf then display_error ctx "Cannot declare a variable with same name as a method" mainf.cf_pos; - (if not (Meta.has Meta.Overload mainf.cf_meta) then display_error ctx ("Overloaded methods must have @:overload metadata") mainf.cf_pos); - mainf.cf_overloads <- cf :: mainf.cf_overloads + (if not (has_class_field_flag mainf CfOverload) then display_error ctx ("Overloaded methods must have 'overload' accessor") mainf.cf_pos); + mainf.cf_overloads <- cf :: cf.cf_overloads @ mainf.cf_overloads else let type_kind,path = match c.cl_kind with | KAbstractImpl a -> "abstract",a.a_path + | KModuleFields m -> "module",m.m_path | _ -> "class",c.cl_path in display_error ctx ("Duplicate " ^ type_kind ^ " field declaration : " ^ s_type_path path ^ "." ^ cf.cf_name) cf.cf_name_pos else - if fctx.do_add then add_field c cf + if fctx.do_add then TClass.add_field c cf end with Error (Custom str,p2) when p = p2 -> display_error ctx str p @@ -1606,30 +1694,33 @@ let init_class ctx c p context_init herits fields = false, null_pos in if has_struct_init then - if c.cl_interface then + if (has_class_flag c CInterface) then display_error ctx "@:structInit is not allowed on interfaces" struct_init_pos + else if (has_class_flag c CAbstract) then + display_error ctx "@:structInit is not allowed on abstract classes" struct_init_pos else ensure_struct_init_constructor ctx c fields p; begin match cctx.uninitialized_final with - | Some pf when c.cl_constructor = None -> - display_error ctx "This class has uninitialized final vars, which requires a constructor" p; - display_error ctx "Example of an uninitialized final var" pf; + | cf :: cfl when c.cl_constructor = None -> + if Diagnostics.is_diagnostics_run ctx.com cf.cf_name_pos then begin + let diag = { + mf_pos = c.cl_name_pos; + mf_on = TClassDecl c; + mf_fields = []; + mf_cause = FinalFields (cf :: cfl); + } in + let display = ctx.com.display_information in + display.module_diagnostics <- MissingFields diag :: display.module_diagnostics + end else begin + display_error ctx "This class has uninitialized final vars, which requires a constructor" p; + display_error ctx "Example of an uninitialized final var" cf.cf_name_pos; + end | _ -> () end; if not has_struct_init then (* add_constructor does not deal with overloads correctly *) if not ctx.com.config.pf_overload then TypeloadFunction.add_constructor ctx c cctx.force_constructor p; - (* check overloaded constructors *) - (if ctx.com.config.pf_overload && not cctx.is_lib then match c.cl_constructor with - | Some ctor -> - delay ctx PTypeField (fun () -> - (* TODO: consider making a broader check, and treat some types, like TAnon and type parameters as Dynamic *) - List.iter (fun f -> - check_overload ctx f (ctor :: ctor.cf_overloads) - ) (ctor :: ctor.cf_overloads) - ) - | _ -> ()); (* push delays in reverse order so they will be run in correct order *) List.iter (fun (ctx,r) -> init_class_done ctx; diff --git a/src/typing/typeloadFunction.ml b/src/typing/typeloadFunction.ml index 06dfce67..bf0c3443 100644 --- a/src/typing/typeloadFunction.ml +++ b/src/typing/typeloadFunction.ml @@ -27,24 +27,13 @@ open DisplayTypes.DisplayMode open DisplayException open Common open Error - -let type_function_arg ctx t e opt p = - (* TODO https://github.com/HaxeFoundation/haxe/issues/8461 *) - (* delay ctx PTypeField (fun() -> - if ExtType.is_void (follow t) then - error "Arguments of type Void are not allowed" p - ); *) - if opt then - let e = (match e with None -> Some (EConst (Ident "null"),null_pos) | _ -> e) in - ctx.t.tnull t, e - else - let t = match e with Some (EConst (Ident "null"),null_pos) -> ctx.t.tnull t | _ -> t in - t, e +open FunctionArguments let save_field_state ctx = let old_ret = ctx.ret in let old_fun = ctx.curfun in let old_opened = ctx.opened in + let old_monos = ctx.monomorphs.perfunction in let old_in_function = ctx.in_function in let locals = ctx.locals in (fun () -> @@ -52,66 +41,23 @@ let save_field_state ctx = ctx.ret <- old_ret; ctx.curfun <- old_fun; ctx.opened <- old_opened; + ctx.monomorphs.perfunction <- old_monos; ctx.in_function <- old_in_function; ) -let type_var_field ctx t e stat do_display p = - if stat then ctx.curfun <- FunStatic else ctx.curfun <- FunMember; - let e = if do_display then Display.ExprPreprocessing.process_expr ctx.com e else e in - let e = type_expr ctx e (WithType.with_type t) in - let e = AbstractCast.cast_or_unify ctx t e p in - match t with - | TType ({ t_path = ([],"UInt") },[]) | TAbstract ({ a_path = ([],"UInt") },[]) when stat -> { e with etype = t } - | _ -> e - -let type_var_field ctx t e stat do_display p = - let save = save_field_state ctx in - Std.finally save (type_var_field ctx t e stat do_display) p - let type_function_params ctx fd fname p = let params = ref [] in params := Typeload.type_type_params ctx ([],fname) (fun() -> !params) p fd.f_params; !params -let type_function_arg_value ctx t c do_display = - match c with - | None -> None - | Some e -> - let p = pos e in - let e = if do_display then Display.ExprPreprocessing.process_expr ctx.com e else e in - let e = ctx.g.do_optimize ctx (type_expr ctx e (WithType.with_type t)) in - unify ctx e.etype t p; - let rec loop e = match e.eexpr with - | TConst _ -> Some e - | TField({eexpr = TTypeExpr _},FEnum _) -> Some e - | TField({eexpr = TTypeExpr _},FStatic({cl_kind = KAbstractImpl a},cf)) when Meta.has Meta.Enum a.a_meta && Meta.has Meta.Enum cf.cf_meta -> Some e - | TCast(e,None) -> loop e - | _ -> - if ctx.com.display.dms_kind = DMNone || ctx.com.display.dms_inline && ctx.com.display.dms_error_policy = EPCollect then - display_error ctx "Parameter default value should be constant" p; - None - in - loop e - -let process_function_arg ctx n t c do_display p = - if starts_with n '$' then error "Function argument names starting with a dollar are not allowed" p; - type_function_arg_value ctx t c do_display - -let type_function ctx args ret fmode f do_display p = - let fargs = List.map2 (fun (n,c,t) ((_,pn),_,m,_,_) -> - let c = process_function_arg ctx n t c do_display pn in - let v = add_local_with_origin ctx TVOArgument n t pn in - v.v_meta <- v.v_meta @ m; - if do_display && DisplayPosition.display_position#enclosed_in pn then - DisplayEmitter.display_variable ctx v pn; - if n = "this" then v.v_meta <- (Meta.This,[],null_pos) :: v.v_meta; - v,c - ) args f.f_args in +let type_function ctx (args : function_arguments) ret fmode e do_display p = ctx.in_function <- true; ctx.curfun <- fmode; ctx.ret <- ret; ctx.opened <- []; - let e = match f.f_expr with + ctx.monomorphs.perfunction <- []; + args#bring_into_context; + let e = match e with | None -> if ctx.com.display.dms_error_policy = EPIgnore then (* when we don't care because we're in display mode, just act like @@ -120,7 +66,10 @@ let type_function ctx args ret fmode f do_display p = *) EBlock [],p else - error "Function body required" p + if fmode = FunMember && has_class_flag ctx.curclass CAbstract then + error "Function body or abstract modifier required" p + else + error "Function body required" p | Some e -> e in let is_position_debug = Meta.has (Meta.Custom ":debug.position") ctx.curfield.cf_meta in @@ -170,7 +119,7 @@ let type_function ctx args ret fmode f do_display p = None | Some (csup,tl) -> try - let _,cf = get_constructor (fun f->f.cf_type) csup in + let cf = get_constructor csup in Some (Meta.has Meta.CompilerGenerated cf.cf_meta,TInst(csup,tl)) with Not_found -> None @@ -224,28 +173,19 @@ let type_function ctx args ret fmode f do_display p = | _ -> e in List.iter (fun r -> r := Closed) ctx.opened; + List.iter (fun (m,p) -> safe_mono_close ctx m p) ctx.monomorphs.perfunction; if is_position_debug then print_endline ("typing:\n" ^ (Texpr.dump_with_pos "" e)); - e , fargs + e -let type_function ctx args ret fmode f do_display p = +let type_function ctx args ret fmode e do_display p = let save = save_field_state ctx in - Std.finally save (type_function ctx args ret fmode f do_display) p + Std.finally save (type_function ctx args ret fmode e do_display) p let add_constructor ctx c force_constructor p = - let super() = - match c.cl_super with - | None -> None - | Some ({ cl_constructor = Some cfsup } as csup,cparams) -> - Some(cfsup,csup,cparams) - | Some (csup,cparams) -> - try - let _,cfsup = Type.get_constructor (fun ctor -> apply_params csup.cl_params cparams ctor.cf_type) csup in - Some(cfsup,csup,cparams) - with Not_found -> - None - in - match c.cl_constructor, super() with - | None, Some(cfsup,csup,cparams) when not c.cl_extern -> + if c.cl_constructor <> None then () else + let constructor = try Some (Type.get_constructor_class c (List.map snd c.cl_params)) with Not_found -> None in + match constructor with + | Some(cfsup,csup,cparams) when not (has_class_flag c CExtern) -> let cf = { cfsup with cf_pos = p; @@ -261,7 +201,7 @@ let add_constructor ctx c force_constructor p = pass = PTypeField; } in ignore (follow cfsup.cf_type); (* make sure it's typed *) - (if ctx.com.config.pf_overload then List.iter (fun cf -> ignore (follow cf.cf_type)) cf.cf_overloads); + List.iter (fun cf -> ignore (follow cf.cf_type)) cf.cf_overloads; let map_arg (v,def) = (* let's optimize a bit the output by not always copying the default value @@ -270,7 +210,7 @@ let add_constructor ctx c force_constructor p = let null () = Some (Texpr.Builder.make_null v.v_type v.v_pos) in match ctx.com.platform, def with | _, Some _ when not ctx.com.config.pf_static -> v, null() - | Flash, Some ({eexpr = TConst (TString _)}) when not csup.cl_extern -> v, null() + | Flash, Some ({eexpr = TConst (TString _)}) when not (has_class_flag csup CExtern) -> v, null() | Cpp, Some ({eexpr = TConst (TString _)}) -> v, def | Cpp, Some _ -> { v with v_type = ctx.t.tnull v.v_type }, null() | _ -> v, def @@ -307,7 +247,7 @@ let add_constructor ctx c force_constructor p = ) "add_constructor" in cf.cf_type <- TLazy r; c.cl_constructor <- Some cf; - | None,_ when force_constructor -> + | _ when force_constructor -> let constr = mk (TFunction { tf_args = []; tf_type = ctx.t.tvoid; diff --git a/src/typing/typeloadModule.ml b/src/typing/typeloadModule.ml index 5243e52a..3ac50d12 100644 --- a/src/typing/typeloadModule.ml +++ b/src/typing/typeloadModule.ml @@ -39,6 +39,7 @@ let make_module ctx mpath file loadp = m_id = alloc_mid(); m_path = mpath; m_types = []; + m_statics = None; m_extra = module_extra (Path.get_full_path file) (Define.get_signature ctx.com.defines) (file_time file) (if ctx.in_macro then MMacro else MCode) (get_policy ctx mpath); } in m @@ -192,16 +193,26 @@ end let module_pass_1 ctx m tdecls loadp = let com = ctx.com in let decls = ref [] in - let make_path name priv p = + let statics = ref [] in + let check_name name meta also_statics p = + DeprecationCheck.check_is com name meta p; + let error prev_pos = + display_error ctx ("Name " ^ name ^ " is already defined in this module") p; + error (compl_msg "Previous declaration here") prev_pos; + in List.iter (fun (t2,(_,p2)) -> - if snd (t_path t2) = name then begin - display_error ctx ("Type name " ^ name ^ " is already defined in this module") p; - error "Previous declaration here" p2; - end + if snd (t_path t2) = name then error (t_infos t2).mt_name_pos ) !decls; + if also_statics then + List.iter (fun (d,_) -> + if fst d.d_name = name then error (snd d.d_name) + ) !statics + in + let make_path name priv meta p = + check_name name meta true p; if priv then (fst m.m_path @ ["_" ^ snd m.m_path], name) else (fst m.m_path, name) in - let pt = ref None in + let has_declaration = ref false in let rec make_decl acc decl = let p = snd decl in let check_type_name type_name meta = @@ -210,14 +221,18 @@ let module_pass_1 ctx m tdecls loadp = in let acc = (match fst decl with | EImport _ | EUsing _ -> - (match !pt with - | None -> acc - | Some _ -> error "import and using may not appear after a type declaration" p) + if !has_declaration then error "import and using may not appear after a declaration" p; + acc + | EStatic d -> + check_name (fst d.d_name) d.d_meta false (snd d.d_name); + has_declaration := true; + statics := (d,p) :: !statics; + acc; | EClass d -> let name = fst d.d_name in - pt := Some p; + has_declaration := true; let priv = List.mem HPrivate d.d_flags in - let path = make_path name priv p in + let path = make_path name priv d.d_meta (snd d.d_name) in let c = mk_class m path p (pos d.d_name) in (* we shouldn't load any other type until we propertly set cl_build *) c.cl_build <- (fun() -> error (s_type_path c.cl_path ^ " is not ready to be accessed, separate your type declarations in several files") p); @@ -225,20 +240,25 @@ let module_pass_1 ctx m tdecls loadp = c.cl_private <- priv; c.cl_doc <- d.d_doc; c.cl_meta <- d.d_meta; + if List.mem HAbstract d.d_flags then add_class_flag c CAbstract; List.iter (function - | HExtern -> c.cl_extern <- true - | HInterface -> c.cl_interface <- true - | HFinal -> c.cl_final <- true + | HExtern -> add_class_flag c CExtern + | HInterface -> add_class_flag c CInterface + | HFinal -> add_class_flag c CFinal | _ -> () ) d.d_flags; - if not c.cl_extern then check_type_name name d.d_meta; + if not (has_class_flag c CExtern) then check_type_name name d.d_meta; + if has_class_flag c CAbstract then begin + if has_class_flag c CInterface then display_error ctx "An interface may not be abstract" c.cl_name_pos; + if has_class_flag c CFinal then display_error ctx "An abstract class may not be final" c.cl_name_pos; + end; decls := (TClassDecl c, decl) :: !decls; acc | EEnum d -> let name = fst d.d_name in - pt := Some p; + has_declaration := true; let priv = List.mem EPrivate d.d_flags in - let path = make_path name priv p in + let path = make_path name priv d.d_meta p in if Meta.has (Meta.Custom ":fakeEnum") d.d_meta then error "@:fakeEnum enums is no longer supported in Haxe 4, use extern enum abstract instead" p; let e = { e_path = path; @@ -261,10 +281,9 @@ let module_pass_1 ctx m tdecls loadp = | ETypedef d -> let name = fst d.d_name in check_type_name name d.d_meta; - if has_meta Meta.Using d.d_meta then error "@:using on typedef is not allowed" p; - pt := Some p; + has_declaration := true; let priv = List.mem EPrivate d.d_flags in - let path = make_path name priv p in + let path = make_path name priv d.d_meta p in let t = { t_path = path; t_module = m; @@ -289,7 +308,7 @@ let module_pass_1 ctx m tdecls loadp = let name = fst d.d_name in check_type_name name d.d_meta; let priv = List.mem AbPrivate d.d_flags in - let path = make_path name priv p in + let path = make_path name priv d.d_meta p in let a = { a_path = path; a_private = priv; @@ -311,7 +330,9 @@ let module_pass_1 ctx m tdecls loadp = a_this = mk_mono(); a_read = None; a_write = None; + a_enum = List.mem AbEnum d.d_flags || Meta.has Meta.Enum d.d_meta; } in + if a.a_enum && not (Meta.has Meta.Enum a.a_meta) then a.a_meta <- (Meta.Enum,[],null_pos) :: a.a_meta; decls := (TAbstractDecl a, decl) :: !decls; match d.d_data with | [] when Meta.has Meta.CoreType a.a_meta -> @@ -342,13 +363,50 @@ let module_pass_1 ctx m tdecls loadp = ) a.a_meta; a.a_impl <- Some c; c.cl_kind <- KAbstractImpl a; - c.cl_final <- true; + add_class_flag c CFinal; | _ -> die "" __LOC__); acc ) in decl :: acc in let tdecls = List.fold_left make_decl [] tdecls in + let tdecls = + match !statics with + | [] -> + tdecls + | statics -> + let first_pos = ref null_pos in + let fields = List.map (fun (d,p) -> + first_pos := p; + { + cff_name = d.d_name; + cff_doc = d.d_doc; + cff_pos = p; + cff_meta = d.d_meta; + cff_access = (AStatic,null_pos) :: d.d_flags; + cff_kind = d.d_data; + } + ) statics in + let p = let p = !first_pos in { p with pmax = p.pmin } in + let c = EClass { + d_name = (snd m.m_path) ^ "_Fields_", null_pos; + d_flags = [HPrivate]; + d_data = List.rev fields; + d_doc = None; + d_params = []; + d_meta = [] + } in + let tdecls = make_decl tdecls (c,p) in + (match !decls with + | (TClassDecl c,_) :: _ -> + assert (m.m_statics = None); + m.m_statics <- Some c; + c.cl_kind <- KModuleFields m; + add_class_flag c CFinal; + | _ -> assert false); + tdecls + + in let decls = List.rev !decls in decls, List.rev tdecls @@ -391,6 +449,7 @@ let load_enum_field ctx e et is_flat index c = ef_params = params; ef_meta = c.ec_meta; } in + DeprecationCheck.check_is ctx.com f.ef_name f.ef_meta f.ef_name_pos; let cf = { (mk_field f.ef_name f.ef_type p f.ef_name_pos) with cf_kind = (match follow f.ef_type with @@ -418,7 +477,7 @@ let init_module_type ctx context_init (decl,p) = if Filename.basename p.pfile <> "import.hx" then ImportHandling.add_import_position ctx p path; in let check_path_display path p = - if DisplayPosition.display_position#is_in_file p.pfile then DisplayPath.handle_path_display ctx path p + if DisplayPosition.display_position#is_in_file (ctx.com.file_keys#get p.pfile) then DisplayPath.handle_path_display ctx path p in let init_import path mode = check_path_display path p; @@ -443,7 +502,8 @@ let init_module_type ctx context_init (decl,p) = let md = ctx.g.do_load_module ctx (List.map fst pack,tname) p_type in let types = md.m_types in let no_private (t,_) = not (t_infos t).mt_private in - let chk_private t p = if (t_infos t).mt_private then error "You can't import a private type" p in + let error_private p = error "Importing private declarations from a module is not allowed" p in + let chk_private t p = if ctx.m.curmod != (t_infos t).mt_module && (t_infos t).mt_private then error_private p in let has_name name t = snd (t_infos t).mt_path = name in let get_type tname = let t = (try List.find (has_name tname) types with Not_found -> error (StringError.string_error tname (List.map (fun mt -> snd (t_infos mt).mt_path) types) ("Module " ^ s_type_path md.m_path ^ " does not define type " ^ tname)) p_type) in @@ -491,7 +551,16 @@ let init_module_type ctx context_init (decl,p) = | [] -> (match name with | None -> - ctx.m.module_types <- List.filter no_private (List.map (fun t -> t,p) types) @ ctx.m.module_types + ctx.m.module_types <- List.filter no_private (List.map (fun t -> t,p) types) @ ctx.m.module_types; + Option.may (fun c -> + context_init#add (fun () -> + ignore(c.cl_build()); + List.iter (fun cf -> + if has_class_field_flag cf CfPublic then + ctx.m.module_globals <- PMap.add cf.cf_name (TClassDecl c,cf.cf_name,p) ctx.m.module_globals + ) c.cl_ordered_statics + ); + ) md.m_statics | Some(newname,pname) -> ctx.m.module_types <- (rebind (get_type tname) newname pname,p) :: ctx.m.module_types); | [tsub,p2] -> @@ -502,13 +571,39 @@ let init_module_type ctx context_init (decl,p) = ctx.m.module_types <- ((match name with None -> tsub | Some(n,pname) -> rebind tsub n pname),p) :: ctx.m.module_types with Not_found -> (* this might be a static property, wait later to check *) - let tmain = get_type tname in - context_init#add (fun() -> + let find_main_type_static () = + let tmain = get_type tname in try add_static_init tmain name tsub with Not_found -> + (* TODO: mention module-level declarations in the error message? *) display_error ctx (s_type_path (t_infos tmain).mt_path ^ " has no field or subtype " ^ tsub) p - )) + in + context_init#add (fun() -> + match md.m_statics with + | Some c -> + (try + ignore(c.cl_build()); + let rec loop fl = + match fl with + | [] -> raise Not_found + | cf :: rest -> + if cf.cf_name = tsub then + if not (has_class_field_flag cf CfPublic) then + error_private p + else + let imported_name = match name with None -> tsub | Some (n,pname) -> n in + ctx.m.module_globals <- PMap.add imported_name (TClassDecl c,tsub,p) ctx.m.module_globals; + else + loop rest + in + loop c.cl_ordered_statics + with Not_found -> + find_main_type_static ()) + | None -> + find_main_type_static () + ) + ) | (tsub,p2) :: (fname,p3) :: rest -> (match rest with | [] -> () @@ -562,7 +657,7 @@ let init_module_type ctx context_init (decl,p) = let herits = d.d_flags in List.iter (fun (m,_,p) -> if m = Meta.Final then begin - c.cl_final <- true; + add_class_flag c CFinal; (* if p <> null_pos && not (Define.is_haxe3_compat ctx.com.defines) then ctx.com.warning "`@:final class` is deprecated in favor of `final class`" p; *) end @@ -606,7 +701,9 @@ let init_module_type ctx context_init (decl,p) = ctx.pass <- PBuildModule; ctx.curclass <- null_class; delay ctx PBuildClass (fun() -> ignore(c.cl_build())); - if (ctx.com.platform = Java || ctx.com.platform = Cs) && not c.cl_extern then + if Meta.has Meta.InheritDoc c.cl_meta then + delay ctx PConnectField (fun() -> InheritDoc.build_class_doc ctx c); + if (ctx.com.platform = Java || ctx.com.platform = Cs) && not (has_class_flag c CExtern) then delay ctx PTypeField (fun () -> let metas = StrictMeta.check_strict_meta ctx c.cl_meta in if metas <> [] then c.cl_meta <- metas @ c.cl_meta; @@ -650,7 +747,7 @@ let init_module_type ctx context_init (decl,p) = in TypeloadFields.build_module_def ctx (TEnumDecl e) e.e_meta get_constructs context_init (fun (e,p) -> match e with - | EVars [_,_,Some (CTAnonymous fields,p),None] -> + | EVars [{ ev_type = Some (CTAnonymous fields,p); ev_expr = None }] -> constructs := List.map (fun f -> let args, params, t = (match f.cff_kind with | FVar (t,None) -> [], [], t @@ -684,13 +781,16 @@ let init_module_type ctx context_init (decl,p) = fields := PMap.add cf.cf_name cf !fields; incr index; names := (fst c.ec_name) :: !names; + if Meta.has Meta.InheritDoc f.ef_meta then + delay ctx PConnectField (fun() -> InheritDoc.build_enum_field_doc ctx f); ) (!constructs); e.e_names <- List.rev !names; e.e_extern <- e.e_extern; e.e_type.t_params <- e.e_params; e.e_type.t_type <- mk_anon ~fields:!fields (ref (EnumStatics e)); if !is_flat then e.e_meta <- (Meta.FlatEnum,[],null_pos) :: e.e_meta; - + if Meta.has Meta.InheritDoc e.e_meta then + delay ctx PConnectField (fun() -> InheritDoc.build_enum_doc ctx e); if (ctx.com.platform = Java || ctx.com.platform = Cs) && not e.e_extern then delay ctx PTypeField (fun () -> let metas = StrictMeta.check_strict_meta ctx e.e_meta in @@ -746,6 +846,7 @@ let init_module_type ctx context_init (decl,p) = | None -> Monomorph.bind r tt; | Some _ -> die "" __LOC__); | _ -> die "" __LOC__); + TypeloadFields.build_module_def ctx (TTypeDecl t) t.t_meta (fun _ -> []) context_init (fun _ -> ()); if ctx.com.platform = Cs && t.t_meta <> [] then delay ctx PTypeField (fun () -> let metas = StrictMeta.check_strict_meta ctx t.t_meta in @@ -800,15 +901,22 @@ let init_module_type ctx context_init (decl,p) = a.a_this <- at; is_type := true; | AbExtern -> - (match a.a_impl with Some c -> c.cl_extern <- true | None -> (* Hmmmm.... *) ()) - | AbPrivate -> () + (match a.a_impl with Some c -> add_class_flag c CExtern | None -> (* Hmmmm.... *) ()) + | AbPrivate | AbEnum -> () ) d.d_flags; + a.a_from <- List.rev a.a_from; + a.a_to <- List.rev a.a_to; if not !is_type then begin if Meta.has Meta.CoreType a.a_meta then a.a_this <- TAbstract(a,List.map snd a.a_params) else error "Abstract is missing underlying type declaration" a.a_pos - end + end; + if Meta.has Meta.InheritDoc a.a_meta then + delay ctx PConnectField (fun() -> InheritDoc.build_abstract_doc ctx a); + | EStatic _ -> + (* nothing to do here as module fields are collected into a special EClass *) + () let module_pass_2 ctx m decls tdecls p = (* here is an additional PASS 1 phase, which define the type parameters for all module types. @@ -859,7 +967,7 @@ let type_types_into_module ctx m tdecls p = wildcard_packages = []; module_imports = []; }; - is_display_file = (ctx.com.display.dms_kind <> DMNone && DisplayPosition.display_position#is_in_file m.m_extra.m_file); + is_display_file = (ctx.com.display.dms_kind <> DMNone && DisplayPosition.display_position#is_in_file (Path.UniqueKey.lazy_key m.m_extra.m_file)); bypass_accessor = 0; meta = []; this_stack = []; @@ -883,6 +991,11 @@ let type_types_into_module ctx m tdecls p = in_loop = false; opened = []; in_call_args = false; + in_overload_call_args = false; + delayed_display = None; + monomorphs = { + perfunction = []; + }; vthis = None; memory_marker = Typecore.memory_marker; } in @@ -895,7 +1008,7 @@ let type_types_into_module ctx m tdecls p = ctx let handle_import_hx ctx m decls p = - let path_split = match List.rev (Path.get_path_parts m.m_extra.m_file) with + let path_split = match List.rev (Path.get_path_parts (Path.UniqueKey.lazy_path m.m_extra.m_file)) with | [] -> [] | _ :: l -> l in @@ -992,7 +1105,7 @@ let load_module ctx m p = raise (Forbid_package (inf,p::pl,pf)) ) in add_dependency ctx.m.curmod m2; - if ctx.pass = PTypeField then flush_pass ctx PBuildClass "load_module"; + if ctx.pass = PTypeField then flush_pass ctx PConnectField "load_module"; m2 (* let load_module ctx m p = diff --git a/src/typing/typeloadParse.ml b/src/typing/typeloadParse.ml index cd650c49..a181a1d3 100644 --- a/src/typing/typeloadParse.ml +++ b/src/typing/typeloadParse.ml @@ -36,7 +36,7 @@ let parse_file_from_lexbuf com file p lexbuf = Lexer.init file; incr stats.s_files_parsed; let parse_result = try - ParserEntry.parse com.defines lexbuf file + ParserEntry.parse Grammar.parse_file com.defines lexbuf file with | Sedlexing.MalFormed -> t(); @@ -47,8 +47,8 @@ let parse_file_from_lexbuf com file p lexbuf = in begin match !Parser.display_mode,parse_result with | DMModuleSymbols (Some ""),_ -> () - | DMModuleSymbols filter,(ParseSuccess(data,_,_)) when filter = None && DisplayPosition.display_position#is_in_file file -> - let ds = DocumentSymbols.collect_module_symbols (filter = None) data in + | DMModuleSymbols filter,(ParseSuccess(data,_,_)) when filter = None && DisplayPosition.display_position#is_in_file (com.file_keys#get file) -> + let ds = DocumentSymbols.collect_module_symbols None (filter = None) data in DisplayException.raise_module_symbols (DocumentSymbols.Printer.print_module_symbols com [file,ds] filter); | _ -> () @@ -63,7 +63,7 @@ let parse_file_from_string com file p string = let current_stdin = ref None (* TODO: we're supposed to clear this at some point *) let parse_file com file p = - let use_stdin = (Common.defined com Define.DisplayStdin) && DisplayPosition.display_position#is_in_file file in + let use_stdin = (Common.defined com Define.DisplayStdin) && DisplayPosition.display_position#is_in_file (com.file_keys#get file) in if use_stdin then let s = match !current_stdin with @@ -112,8 +112,8 @@ let resolve_module_file com m remap p = (* if we try to load a std.xxxx class and resolve a real std file, the package name is not valid, ignore *) (match fst m with | "std" :: _ -> - let file_key = Path.UniqueKey.create file in - if List.exists (fun path -> Path.UniqueKey.starts_with file_key (Path.UniqueKey.create path)) com.std_path then raise Not_found; + let file_key = com.file_keys#get file in + if List.exists (fun path -> Path.UniqueKey.starts_with file_key (com.file_keys#get path)) com.std_path then raise Not_found; | _ -> ()); if !forbid then begin let parse_result = (!parse_hook) com file p in @@ -123,9 +123,10 @@ let resolve_module_file com m remap p = | (EEnum d,_) :: _ -> d.d_meta | (EAbstract d,_) :: _ -> d.d_meta | (ETypedef d,_) :: _ -> d.d_meta + | (EStatic d,_) :: _ -> d.d_meta | [] -> [] in - let meta = match parse_result with + let meta = match parse_result with | ParseSuccess((_,decls),_,_) -> loop decls | ParseError _ -> [] in @@ -337,6 +338,7 @@ let parse_module ctx m p = | EEnum d -> build EPrivate d | ETypedef d -> build EPrivate d | EAbstract d -> build AbPrivate d + | EStatic d -> build (AStatic,null_pos) d | EImport _ | EUsing _ -> acc ) [(EImport (List.map (fun s -> s,null_pos) (!remap @ [snd m]),INormal),null_pos)] decls) else diff --git a/src/typing/typer.ml b/src/typing/typer.ml index ad9e692f..5f75374c 100644 --- a/src/typing/typer.ml +++ b/src/typing/typer.ml @@ -16,6 +16,7 @@ along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. *) +open Extlib_leftovers open Ast open DisplayTypes.DisplayMode open DisplayException @@ -28,47 +29,13 @@ open Error open Globals open TyperBase open Fields +open CallUnification open Calls +open Operators (* ---------------------------------------------------------------------- *) (* TOOLS *) -let check_assign ctx e = - match e.eexpr with - | TLocal {v_final = true} -> - error "Cannot assign to final" e.epos - | TLocal {v_extra = None} | TArray _ | TField _ | TIdent _ -> - () - | TConst TThis | TTypeExpr _ when ctx.untyped -> - () - | _ -> - invalid_assign e.epos - -type type_class = - | KInt - | KFloat - | KString - | KUnk - | KDyn - | KOther - | KNumParam of t - | KStrParam of t - | KAbstract of tabstract * t list - -let rec classify t = - match follow t with - | TInst ({ cl_path = ([],"String") },[]) -> KString - | TAbstract({a_impl = Some _} as a,tl) -> KAbstract (a,tl) - | TAbstract ({ a_path = [],"Int" },[]) -> KInt - | TAbstract ({ a_path = [],"Float" },[]) -> KFloat - | TAbstract (a,[]) when List.exists (fun t -> match classify t with KInt | KFloat -> true | _ -> false) a.a_to -> KNumParam t - | TInst ({ cl_kind = KTypeParameter ctl },_) when List.exists (fun t -> match classify t with KInt | KFloat -> true | _ -> false) ctl -> KNumParam t - | TAbstract (a,[]) when List.exists (fun t -> match classify t with KString -> true | _ -> false) a.a_to -> KStrParam t - | TInst ({ cl_kind = KTypeParameter ctl },_) when List.exists (fun t -> match classify t with KString -> true | _ -> false) ctl -> KStrParam t - | TMono r when r.tm_type = None -> KUnk - | TDynamic _ -> KDyn - | _ -> KOther - let get_iterator_param t = match follow t with | TAnon a -> @@ -102,9 +69,9 @@ let maybe_type_against_enum ctx f with_type iscall p = let rec loop stack t = match follow t with | TEnum (en,_) -> true,en.e_path,en.e_names,TEnumDecl en - | TAbstract ({a_impl = Some c} as a,_) when has_meta Meta.Enum a.a_meta -> + | TAbstract ({a_impl = Some c} as a,_) when a.a_enum -> let fields = ExtList.List.filter_map (fun cf -> - if Meta.has Meta.Enum cf.cf_meta then Some cf.cf_name else None + if has_class_field_flag cf CfEnum then Some cf.cf_name else None ) c.cl_ordered_statics in false,a.a_path,fields,TAbstractDecl a | TAbstract (a,pl) when not (Meta.has Meta.CoreType a.a_meta) -> @@ -156,7 +123,7 @@ let maybe_type_against_enum ctx f with_type iscall p = f() let check_error ctx err p = match err with - | Module_not_found ([],name) when Diagnostics.is_diagnostics_run p -> + | Module_not_found ([],name) when Diagnostics.is_diagnostics_run ctx.com p -> DisplayToplevel.handle_unresolved_identifier ctx name p true | _ -> display_error ctx (error_msg err) p @@ -164,35 +131,10 @@ let check_error ctx err p = match err with (* ---------------------------------------------------------------------- *) (* PASS 3 : type expression & check structure *) -let rec unify_min_raise basic (el:texpr list) : t = - let rec base_types t = - let tl = ref [] in - let rec loop t = (match t with - | TInst(cl, params) -> - (match cl.cl_kind with - | KTypeParameter tl -> List.iter loop tl - | _ -> ()); - List.iter (fun (ic, ip) -> - let t = apply_params cl.cl_params params (TInst (ic,ip)) in - loop t - ) cl.cl_implements; - (match cl.cl_super with None -> () | Some (csup, pl) -> - let t = apply_params cl.cl_params params (TInst (csup,pl)) in - loop t); - tl := t :: !tl; - | TType (td,pl) -> - loop (apply_params td.t_params pl td.t_type); - (* prioritize the most generic definition *) - tl := t :: !tl; - | TLazy f -> loop (lazy_type f) - | TMono r -> (match r.tm_type with None -> () | Some t -> loop t) - | _ -> tl := t :: !tl) - in - loop t; - !tl - in +let rec unify_min_raise ctx (el:texpr list) : t = + let basic = ctx.com.basic in match el with - | [] -> mk_mono() + | [] -> spawn_monomorph ctx null_pos | [e] -> e.etype | _ -> let rec chk_null e = is_null e.etype || is_explicit_null e.etype || @@ -205,7 +147,6 @@ let rec unify_min_raise basic (el:texpr list) : t = | TParenthesis e | TMeta(_,e) -> chk_null e | _ -> false in - (* First pass: Try normal unification and find out if null is involved. *) let rec loop t = function | [] -> @@ -221,7 +162,7 @@ let rec unify_min_raise basic (el:texpr list) : t = with Unify_error _ -> true, t in - let has_error, t = loop (mk_mono()) el in + let has_error, t = loop (spawn_monomorph ctx null_pos) el in if not has_error then t else try @@ -245,14 +186,51 @@ let rec unify_min_raise basic (el:texpr list) : t = raise Not_found ) PMap.empty el in let fields = PMap.foldi (fun n el acc -> - let t = try unify_min_raise basic el with Unify_error _ -> raise Not_found in + let t = try unify_min_raise ctx el with Unify_error _ -> raise Not_found in PMap.add n (mk_field n t (List.hd el).epos null_pos) acc ) fields PMap.empty in mk_anon ~fields (ref Closed) - with Not_found -> + with Not_found -> try + (* specific case for TFun, see #9579 *) + let e0,el = match el with + | e0 :: el -> e0,el + | _ -> raise Exit + in + let args,tr0 = match follow e0.etype with + | TFun(tl,tr) -> + Array.of_list tl,tr + | _ -> + raise Exit + in + let arity = Array.length args in + let rets = List.map (fun e -> match follow e.etype with + | TFun(tl,tr) -> + let ta = Array.of_list tl in + if Array.length ta <> arity then raise Exit; + for i = 0 to arity - 1 do + let (_,_,tcur) = args.(i) in + let (_,_,tnew) as argnew = ta.(i) in + if Type.does_unify tnew tcur then + args.(i) <- argnew + else if not (Type.does_unify tcur tnew) then + raise Exit + done; + tr + | _ -> + raise Exit + ) el in + let common_types = UnifyMinT.collect_base_types tr0 in + let tr = match UnifyMinT.unify_min' default_unification_context common_types rets with + | UnifyMinOk t -> + t + | UnifyMinError(l,index) -> + raise Exit + in + TFun(Array.to_list args,tr) + with Exit -> (* Second pass: Get all base types (interfaces, super classes and their interfaces) of most general type. Then for each additional type filter all types that do not unify. *) - let common_types = base_types t in + let common_types = UnifyMinT.collect_base_types t in let dyn_types = List.fold_left (fun acc t -> let rec loop c = Meta.has Meta.UnifyMinDynamic c.cl_meta || (match c.cl_super with None -> false | Some (c,_) -> loop c) @@ -262,26 +240,18 @@ let rec unify_min_raise basic (el:texpr list) : t = TInst (c,List.map (fun _ -> t_dynamic) params) :: acc | _ -> acc ) [] common_types in - let common_types = ref (match List.rev dyn_types with [] -> common_types | l -> common_types @ l) in - let loop e = - let first_error = ref None in - let filter t = (try Type.unify e.etype t; true - with Unify_error l -> if !first_error = None then first_error := Some(Unify l,e.epos); false) - in - common_types := List.filter filter !common_types; - match !common_types, !first_error with - | [], Some(err,p) -> raise_error err p - | _ -> () - in - match !common_types with - | [] -> - error "No common base type found" (punion (List.hd el).epos (List.hd (List.rev el)).epos) - | _ -> - List.iter loop (List.tl el); - List.hd !common_types + let common_types = (match List.rev dyn_types with [] -> common_types | l -> common_types @ l) in + let el = List.tl el in + let tl = List.map (fun e -> e.etype) el in + begin match UnifyMinT.unify_min' default_unification_context common_types tl with + | UnifyMinOk t -> + t + | UnifyMinError(l,index) -> + raise_error (Unify l) (List.nth el index).epos + end let unify_min ctx el = - try unify_min_raise ctx.com.basic el + try unify_min_raise ctx el with Error (Unify l,p) -> if not ctx.untyped then display_error ctx (error_msg (Unify l)) p; (List.hd el).etype @@ -293,7 +263,8 @@ let unify_min_for_type_source ctx el src = | _ -> unify_min ctx el -let rec type_ident_raise ctx i p mode = +let rec type_ident_raise ctx i p mode with_type = + let is_set = match mode with MSet _ -> true | _ -> false in match i with | "true" -> if mode = MGet then @@ -306,13 +277,13 @@ let rec type_ident_raise ctx i p mode = else AKNo i | "this" -> - if mode = MSet then add_class_field_flag ctx.curfield CfModifiesThis; + if is_set then add_class_field_flag ctx.curfield CfModifiesThis; (match mode, ctx.curclass.cl_kind with - | MSet, KAbstractImpl _ -> + | MSet _, KAbstractImpl _ -> if not (assign_to_this_is_allowed ctx) then error "Abstract 'this' value can only be modified inside an inline function" p; AKExpr (get_this ctx p) - | (MCall, KAbstractImpl _) | (MGet, _)-> AKExpr(get_this ctx p) + | (MCall _, KAbstractImpl _) | (MGet, _)-> AKExpr(get_this ctx p) | _ -> AKNo i) | "super" -> let t = (match ctx.curclass.cl_super with @@ -327,27 +298,29 @@ let rec type_ident_raise ctx i p mode = AKExpr (mk (TConst TSuper) t p) | "null" -> if mode = MGet then - AKExpr (null (mk_mono()) p) + AKExpr (null (spawn_monomorph ctx p) p) else AKNo i | _ -> try let v = PMap.find i ctx.locals in (match v.v_extra with - | Some (params,e) -> - let t = monomorphs params v.v_type in + | Some ve -> + let (params,e) = (ve.v_params,ve.v_expr) in + let t = apply_params params (Monomorph.spawn_constrained_monos (fun t -> t) params) v.v_type in (match e with | Some ({ eexpr = TFunction f } as e) when ctx.com.display.dms_inline -> begin match mode with - | MSet -> error "Cannot set inline closure" p + | MSet _ -> error "Cannot set inline closure" p | MGet -> error "Cannot create closure on inline closure" p - | MCall -> + | MCall _ -> (* create a fake class with a fake field to emulate inlining *) let c = mk_class ctx.m.curmod (["local"],v.v_name) e.epos null_pos in let cf = { (mk_field v.v_name v.v_type e.epos null_pos) with cf_params = params; cf_expr = Some e; cf_kind = Method MethInline } in - c.cl_extern <- true; + add_class_flag c CExtern; c.cl_fields <- PMap.add cf.cf_name cf PMap.empty; - AKInline (mk (TConst TNull) (TInst (c,[])) p, cf, FInstance(c,[],cf), t) + let e = mk (TConst TNull) (TInst (c,[])) p in + AKField (FieldAccess.create e cf (FHInstance(c,[])) true p) end | _ -> AKExpr (mk (TLocal v) t p)) @@ -357,17 +330,36 @@ let rec type_ident_raise ctx i p mode = (* member variable lookup *) if ctx.curfun = FunStatic then raise Not_found; let c , t , f = class_field ctx ctx.curclass (List.map snd ctx.curclass.cl_params) i p in - field_access ctx mode f (match c with None -> FAnon f | Some (c,tl) -> FInstance (c,tl,f)) t (get_this ctx p) p + field_access ctx mode f (match c with None -> FHAnon | Some (c,tl) -> FHInstance (c,tl)) (get_this ctx p) p with Not_found -> try (* static variable lookup *) let f = PMap.find i ctx.curclass.cl_statics in - if Meta.has Meta.Impl f.cf_meta && not (Meta.has Meta.Impl ctx.curfield.cf_meta) && not (Meta.has Meta.Enum f.cf_meta) then + let is_impl = has_class_field_flag f CfImpl in + let is_enum = has_class_field_flag f CfEnum in + if is_impl && not (has_class_field_flag ctx.curfield CfImpl) && not is_enum then error (Printf.sprintf "Cannot access non-static field %s from static method" f.cf_name) p; - let e = type_type ctx ctx.curclass.cl_path p in - (* check_locals_masking already done in type_type *) - field_access ctx mode f (FStatic (ctx.curclass,f)) (field_type ctx ctx.curclass [] f p) e p + let e,fa = match ctx.curclass.cl_kind with + | KAbstractImpl a when is_impl && not is_enum -> + let tl = List.map snd a.a_params in + let e = get_this ctx p in + let e = {e with etype = TAbstract(a,tl)} in + e,FHAbstract(a,tl,ctx.curclass) + | _ -> + let e = type_type ctx ctx.curclass.cl_path p in + e,FHStatic ctx.curclass + in + field_access ctx mode f fa e p + with Not_found -> try + (* module-level statics *) + (match ctx.m.curmod.m_statics with + | None -> raise Not_found + | Some c -> + let f = PMap.find i c.cl_statics in + let e = type_module_type ctx (TClassDecl c) None p in + field_access ctx mode f (FHStatic c) e p + ) with Not_found -> try - let wrap e = if mode = MSet then + let wrap e = if is_set then AKNo i else AKExpr e @@ -378,20 +370,20 @@ let rec type_ident_raise ctx i p mode = | [] -> raise Not_found | (t,pt) :: l -> match t with - | TAbstractDecl ({a_impl = Some c} as a) when Meta.has Meta.Enum a.a_meta -> + | TAbstractDecl ({a_impl = Some c} as a) when a.a_enum -> begin try let cf = PMap.find i c.cl_statics in - if not (Meta.has Meta.Enum cf.cf_meta) then + if not (has_class_field_flag cf CfEnum) then loop l else begin let et = type_module_type ctx (TClassDecl c) None p in - let fa = FStatic(c,cf) in - let t = monomorphs cf.cf_params cf.cf_type in + let inline = match cf.cf_kind with + | Var {v_read = AccInline} -> true + | _ -> false + in + let fa = FieldAccess.create et cf (FHAbstract(a,List.map snd a.a_params,c)) inline p in ImportHandling.mark_import_position ctx pt; - begin match cf.cf_kind with - | Var {v_read = AccInline} -> AKInline(et,cf,fa,t) - | _ -> AKExpr (mk (TField(et,fa)) t p) - end + AKField fa end with Not_found -> loop l @@ -401,16 +393,14 @@ let rec type_ident_raise ctx i p mode = | TTypeDecl t -> (match follow t.t_type with | TEnum (e,_) -> loop ((TEnumDecl e,pt) :: l) - | TAbstract (a,_) when Meta.has Meta.Enum a.a_meta -> loop ((TAbstractDecl a,pt) :: l) + | TAbstract (a,_) when a.a_enum -> loop ((TAbstractDecl a,pt) :: l) | _ -> loop l) | TEnumDecl e -> try let ef = PMap.find i e.e_constrs in let et = type_module_type ctx t None p in - let monos = List.map (fun _ -> mk_mono()) e.e_params in - let monos2 = List.map (fun _ -> mk_mono()) ef.ef_params in ImportHandling.mark_import_position ctx pt; - wrap (mk (TField (et,FEnum (e,ef))) (enum_field_type ctx e ef monos monos2 p) p) + wrap (mk (TField (et,FEnum (e,ef))) (enum_field_type ctx e ef p) p) with Not_found -> loop l in @@ -420,835 +410,11 @@ let rec type_ident_raise ctx i p mode = let t, name, pi = PMap.find i ctx.m.module_globals in ImportHandling.mark_import_position ctx pi; let e = type_module_type ctx t None p in - type_field_default_cfg ctx e name p mode - -(* - We want to try unifying as an integer and apply side effects. - However, in case the value is not a normal Monomorph but one issued - from a Dynamic relaxation, we will instead unify with float since - we don't want to accidentaly truncate the value -*) -let unify_int ctx e k = - let is_dynamic t = - match follow t with - | TDynamic _ -> true - | _ -> false - in - let is_dynamic_array t = - match follow t with - | TInst (_,[p]) -> is_dynamic p - | _ -> true - in - let is_dynamic_field t f = - match follow t with - | TAnon a -> - (try is_dynamic (PMap.find f a.a_fields).cf_type with Not_found -> false) - | TInst (c,tl) -> - (try is_dynamic (apply_params c.cl_params tl ((let _,t,_ = Type.class_field c tl f in t))) with Not_found -> false) - | _ -> - true - in - let is_dynamic_return t = - match follow t with - | TFun (_,r) -> is_dynamic r - | _ -> true - in - (* - This is some quick analysis that matches the most common cases of dynamic-to-mono convertions - *) - let rec maybe_dynamic_mono e = - match e.eexpr with - | TLocal _ -> is_dynamic e.etype - | TArray({ etype = t } as e,_) -> is_dynamic_array t || maybe_dynamic_rec e t - | TField({ etype = t } as e,f) -> is_dynamic_field t (field_name f) || maybe_dynamic_rec e t - | TCall({ etype = t } as e,_) -> is_dynamic_return t || maybe_dynamic_rec e t - | TParenthesis e | TMeta(_,e) -> maybe_dynamic_mono e - | TIf (_,a,Some b) -> maybe_dynamic_mono a || maybe_dynamic_mono b - | _ -> false - and maybe_dynamic_rec e t = - match follow t with - | TMono _ | TDynamic _ -> maybe_dynamic_mono e - (* we might have inferenced a tmono into a single field *) - | TAnon a when !(a.a_status) = Opened -> maybe_dynamic_mono e - | _ -> false - in - match k with - | KUnk | KDyn when maybe_dynamic_mono e -> - unify ctx e.etype ctx.t.tfloat e.epos; - false - | _ -> - unify ctx e.etype ctx.t.tint e.epos; - true + type_field_default_cfg ctx e name p mode with_type -let rec type_binop ctx op e1 e2 is_assign_op with_type p = - let type_non_assign_op abstract_overload_only = - (* If the with_type is an abstract which has exactly one applicable @:op method, we can promote it - to the individual arguments (issue #2786). *) - let wt = match with_type with - | WithType.WithType(t,_) -> - begin match follow t with - | TAbstract(a,_) -> - begin match List.filter (fun (o,_) -> o = OpAssignOp(op) || o == op) a.a_ops with - | [_] -> with_type - | _ -> WithType.value - end - | _ -> - WithType.value - end - | _ -> - WithType.value - in - let e1 = type_expr ctx e1 wt in - type_binop2 ~abstract_overload_only ctx op e1 e2 is_assign_op wt p - in - match op with - | OpAssign -> - let e1 = type_access ctx (fst e1) (snd e1) MSet in - let e2 with_type = type_expr ctx e2 with_type in - (match e1 with - | AKNo s -> error ("Cannot access field or identifier " ^ s ^ " for writing") p - | AKExpr { eexpr = TLocal { v_kind = VUser TVOLocalFunction; v_name = name } } -> - error ("Cannot access function " ^ name ^ " for writing") p - | AKExpr e1 -> - let e2 = e2 (WithType.with_type e1.etype) in - let e2 = AbstractCast.cast_or_unify ctx e1.etype e2 p in - check_assign ctx e1; - (match e1.eexpr , e2.eexpr with - | TLocal i1 , TLocal i2 when i1 == i2 -> error "Assigning a value to itself" p - | TField ({ eexpr = TConst TThis },FInstance (_,_,f1)) , TField ({ eexpr = TConst TThis },FInstance (_,_,f2)) when f1 == f2 -> - error "Assigning a value to itself" p - | _ , _ -> ()); - mk (TBinop (op,e1,e2)) e1.etype p - | AKSet (e,t,cf) -> - let e2 = e2 (WithType.with_type t) in - let e2 = AbstractCast.cast_or_unify ctx t e2 p in - make_call ctx (mk (TField (e,quick_field_dynamic e.etype ("set_" ^ cf.cf_name))) (tfun [t] t) p) [e2] t p - | AKAccess(a,tl,c,ebase,ekey) -> - let e2 = e2 WithType.value in - mk_array_set_call ctx (AbstractCast.find_array_access ctx a tl ekey (Some e2) p) c ebase p - | AKFieldSet(ethis,e1,fname,t) -> - let e2 = e2 (WithType.with_type t) in - begin match follow e1.etype with - | TFun([_;_;(_,_,t)],_) -> unify ctx e2.etype t e2.epos; - | _ -> die "" __LOC__ - end; - make_call ctx e1 [ethis;Texpr.Builder.make_string ctx.t fname null_pos;e2] t p - | AKUsing(ef,_,_,et,_) -> - (* this must be an abstract setter *) - let e2,ret = match follow ef.etype with - | TFun([_;(_,_,t)],ret) -> - let e2 = e2 (WithType.with_type t) in - AbstractCast.cast_or_unify ctx t e2 p,ret - | _ -> error "Invalid field type for abstract setter" p - in - make_call ctx ef [et;e2] ret p - | AKInline _ | AKMacro _ -> - die "" __LOC__) - | OpAssignOp (OpBoolAnd | OpBoolOr) -> - error "The operators ||= and &&= are not supported" p - | OpAssignOp op -> - (match type_access ctx (fst e1) (snd e1) MSet with - | AKNo s -> - (* try abstract operator overloading *) - (try type_non_assign_op true - with Not_found -> error ("Cannot access field or identifier " ^ s ^ " for writing") p - ) - | AKExpr e -> - let save = save_locals ctx in - let v = gen_local ctx e.etype e.epos in - let has_side_effect = OptimizerTexpr.has_side_effect e in - let e1 = if has_side_effect then (EConst(Ident v.v_name),e.epos) else e1 in - let eop = type_binop ctx op e1 e2 true with_type p in - save(); - (match eop.eexpr with - | TBinop (_,_,e2) -> - unify ctx eop.etype e.etype p; - check_assign ctx e; - mk (TBinop (OpAssignOp op,e,e2)) e.etype p; - | TMeta((Meta.RequiresAssign,_,_),e2) -> - unify ctx e2.etype e.etype p; - check_assign ctx e; - begin match e.eexpr with - | TArray(ea1,ea2) when has_side_effect -> - let v1 = gen_local ctx ea1.etype ea1.epos in - let ev1 = mk (TLocal v1) v1.v_type p in - let v2 = gen_local ctx ea2.etype ea2.epos in - let ev2 = mk (TLocal v2) v2.v_type p in - let e = {e with eexpr = TArray(ev1,ev2)} in - mk (TBlock [ - mk (TVar(v1,Some ea1)) ctx.t.tvoid p; - mk (TVar(v2,Some ea2)) ctx.t.tvoid p; - mk (TVar(v,Some e)) ctx.t.tvoid p; - mk (TBinop (OpAssign,e,e2)) e.etype p; - ]) e.etype p - | TField(ea1,fa) when has_side_effect -> - let v1 = gen_local ctx ea1.etype ea1.epos in - let ev1 = mk (TLocal v1) v1.v_type p in - let e = {e with eexpr = TField(ev1,fa)} in - mk (TBlock [ - mk (TVar(v1,Some ea1)) ctx.t.tvoid p; - mk (TVar(v,Some e)) ctx.t.tvoid p; - mk (TBinop (OpAssign,e,e2)) e.etype p; - ]) e.etype p - | _ -> - mk (TBinop (OpAssign,e,e2)) e.etype p; - end - | _ -> - (* this must be an abstract cast *) - check_assign ctx e; - if has_side_effect then - mk (TBlock [ - mk (TVar(v,Some e)) ctx.t.tvoid eop.epos; - eop - ]) eop.etype eop.epos - else - eop) - | AKSet (e,t,cf) -> - let l = save_locals ctx in - let v = gen_local ctx e.etype e.epos in - let ev = mk (TLocal v) e.etype p in - let get = type_binop ctx op (EField ((EConst (Ident v.v_name),p),cf.cf_name),p) e2 true with_type p in - let e' = match get.eexpr with - | TBinop _ | TMeta((Meta.RequiresAssign,_,_),_) -> - unify ctx get.etype t p; - make_call ctx (mk (TField (ev,quick_field_dynamic ev.etype ("set_" ^ cf.cf_name))) (tfun [t] t) p) [get] t p - | _ -> - (* abstract setter *) - get - in - l(); - mk (TBlock [ - mk (TVar (v,Some e)) ctx.t.tvoid p; - e' - ]) t p - | AKUsing(ef,c,cf,et,_) -> - (* abstract setter + getter *) - let ta = match c.cl_kind with KAbstractImpl a -> TAbstract(a, List.map (fun _ -> mk_mono()) a.a_params) | _ -> die "" __LOC__ in - let ret = match follow ef.etype with - | TFun([_;_],ret) -> ret - | _ -> error "Invalid field type for abstract setter" p - in - let l = save_locals ctx in - let v,init_exprs,abstr_this_to_modify = match et.eexpr with - | TLocal v when not (Meta.has Meta.This v.v_meta) -> v,[],None - | _ -> - let v = gen_local ctx ta ef.epos in - (match et.eexpr with - | TLocal { v_meta = m } -> v.v_meta <- Meta.copy_from_to Meta.This m v.v_meta - | _ -> () - ); - let decl_v e = mk (TVar (v,Some e)) ctx.t.tvoid p in - let rec needs_temp_var e = - match e.eexpr with - | TConst TThis | TTypeExpr _ -> false - | TField (e1,(FInstance(_,_,cf) | FStatic(_,cf))) - when has_class_field_flag cf CfFinal -> - needs_temp_var e1 - | TParenthesis e1 -> - needs_temp_var e1 - | _ -> true - in - if has_class_field_flag cf CfModifiesThis then - match et.eexpr with - | TField (target,fa) when needs_temp_var target-> - let tmp = gen_local ctx target.etype target.epos in - let decl_tmp = mk (TVar (tmp,Some target)) ctx.t.tvoid target.epos in - let etmp = mk (TLocal tmp) tmp.v_type tmp.v_pos in - let athis = mk (TField (etmp,fa)) et.etype et.epos in - v,[decl_tmp; decl_v athis],(Some athis) - | TArray (target,index) when needs_temp_var target -> - let tmp = gen_local ctx target.etype target.epos in - let decl_tmp = mk (TVar (tmp,Some target)) ctx.t.tvoid target.epos in - let etmp = mk (TLocal tmp) tmp.v_type tmp.v_pos in - let athis = mk (TArray (etmp,index)) et.etype et.epos in - v,[decl_tmp; decl_v athis],(Some athis) - | _ -> - check_assign ctx et; - v,[decl_v et],(Some et) - else - v,[decl_v et],None - in - let ev = mk (TLocal v) ta p in - (* this relies on the fact that cf_name is set_name *) - let getter_name = String.sub cf.cf_name 4 (String.length cf.cf_name - 4) in - let get = type_binop ctx op (EField ((EConst (Ident v.v_name),p),getter_name),p) e2 true with_type p in - unify ctx get.etype ret p; - l(); - let e_call = make_call ctx ef [ev;get] ret p in - let e_call = - (* - If this method modifies abstract `this`, we should also apply temp var - modifications to the original tempvar-ed expression. - Find code like `v = value` and change it to `et = v = value`, - where `v` is the temp var and `et` is the original expression stored to the temp var. - *) - match abstr_this_to_modify with - | None -> - e_call - | Some athis -> - let rec loop e = - match e.eexpr with - | TBinop(OpAssign,({ eexpr = TLocal v1 } as left),right) when v1 == v -> - let right = { e with eexpr = TBinop(OpAssign,left,loop right) } in - mk (TBinop(OpAssign,athis,right)) e.etype e.epos - | _ -> - map_expr loop e - in - loop e_call - in - mk (TBlock (init_exprs @ [e_call])) ret p - | AKAccess(a,tl,c,ebase,ekey) -> - let cf_get,tf_get,r_get,ekey,_ = AbstractCast.find_array_access ctx a tl ekey None p in - (* bind complex keys to a variable so they do not make it into the output twice *) - let save = save_locals ctx in - let maybe_bind_to_temp e = match Optimizer.make_constant_expression ctx e with - | Some e -> e,None - | None -> - let v = gen_local ctx e.etype p in - let e' = mk (TLocal v) e.etype p in - e', Some (mk (TVar (v,Some e)) ctx.t.tvoid p) - in - let ekey,ekey' = maybe_bind_to_temp ekey in - let ebase,ebase' = maybe_bind_to_temp ebase in - let eget = mk_array_get_call ctx (cf_get,tf_get,r_get,ekey,None) c ebase p in - let eget = type_binop2 ctx op eget e2 true (WithType.with_type eget.etype) p in - unify ctx eget.etype r_get p; - let cf_set,tf_set,r_set,ekey,eget = AbstractCast.find_array_access ctx a tl ekey (Some eget) p in - let eget = match eget with None -> die "" __LOC__ | Some e -> e in - let et = type_module_type ctx (TClassDecl c) None p in - let e = match cf_set.cf_expr,cf_get.cf_expr with - | None,None -> - let ea = mk (TArray(ebase,ekey)) r_get p in - mk (TBinop(OpAssignOp op,ea,type_expr ctx e2 (WithType.with_type r_get))) r_set p - | Some _,Some _ -> - let ef_set = mk (TField(et,(FStatic(c,cf_set)))) tf_set p in - let el = [make_call ctx ef_set [ebase;ekey;eget] r_set p] in - let el = match ebase' with None -> el | Some ebase -> ebase :: el in - let el = match ekey' with None -> el | Some ekey -> ekey :: el in - begin match el with - | [e] -> e - | el -> mk (TBlock el) r_set p - end - | _ -> - error "Invalid array access getter/setter combination" p - in - save(); - e - | AKFieldSet _ -> - error "Invalid operation" p - | AKInline _ | AKMacro _ -> - die "" __LOC__) - | _ -> - type_non_assign_op false - -and type_binop2 ?(abstract_overload_only=false) ctx op (e1 : texpr) (e2 : Ast.expr) is_assign_op wt p = - let with_type = match op with - | OpEq | OpNotEq | OpLt | OpLte | OpGt | OpGte -> WithType.with_type e1.etype - | _ -> wt - in - let e2 = type_expr ctx e2 with_type in - let tint = ctx.t.tint in - let tfloat = ctx.t.tfloat in - let tstring = ctx.t.tstring in - let to_string e = - let rec loop t = match classify t with - | KAbstract ({a_impl = Some c},_) when PMap.mem "toString" c.cl_statics -> - call_to_string ctx e - | KInt | KFloat | KString -> e - | KUnk | KDyn | KNumParam _ | KStrParam _ | KOther -> - let std = type_type ctx ([],"Std") e.epos in - let acc = acc_get ctx (type_field_default_cfg ctx std "string" e.epos MCall) e.epos in - ignore(follow acc.etype); - let acc = (match acc.eexpr with TField (e,FClosure (Some (c,tl),f)) -> { acc with eexpr = TField (e,FInstance (c,tl,f)) } | _ -> acc) in - make_call ctx acc [e] ctx.t.tstring e.epos - | KAbstract (a,tl) -> - try - AbstractCast.cast_or_unify_raise ctx tstring e p - with Error (Unify _,_) -> - loop (Abstract.get_underlying_type a tl) - in - loop e.etype - in - let mk_op e1 e2 t = - if op = OpAdd && (classify t) = KString then - let e1 = to_string e1 in - let e2 = to_string e2 in - mk (TBinop (op,e1,e2)) t p - else - mk (TBinop (op,e1,e2)) t p - in - let make e1 e2 = match op with - | OpAdd -> - mk_op e1 e2 (match classify e1.etype, classify e2.etype with - | KInt , KInt -> - tint - | KFloat , KInt - | KInt, KFloat - | KFloat, KFloat -> - tfloat - | KUnk , KInt -> - if unify_int ctx e1 KUnk then tint else tfloat - | KUnk , KFloat - | KUnk , KString -> - unify ctx e1.etype e2.etype e1.epos; - e1.etype - | KInt , KUnk -> - if unify_int ctx e2 KUnk then tint else tfloat - | KFloat , KUnk - | KString , KUnk -> - unify ctx e2.etype e1.etype e2.epos; - e2.etype - | _ , KString - | KString , _ -> - tstring - | _ , KDyn -> - e2.etype - | KDyn , _ -> - e1.etype - | KUnk , KUnk -> - let ok1 = unify_int ctx e1 KUnk in - let ok2 = unify_int ctx e2 KUnk in - if ok1 && ok2 then tint else tfloat - | KNumParam t1, KNumParam t2 when Type.type_iseq t1 t2 -> - t1 - | KNumParam t, KInt | KInt, KNumParam t -> - t - | KNumParam _, KFloat | KFloat, KNumParam _ | KNumParam _, KNumParam _ -> - tfloat - | KNumParam t, KUnk -> - unify ctx e2.etype tfloat e2.epos; - tfloat - | KUnk, KNumParam t -> - unify ctx e1.etype tfloat e1.epos; - tfloat - | KStrParam _, _ - | _, KStrParam _ -> - tstring - | KAbstract _,KFloat -> - unify ctx e1.etype tfloat e1.epos; - tfloat - | KFloat, KAbstract _ -> - unify ctx e2.etype tfloat e2.epos; - tfloat - | KAbstract _,KInt -> - unify ctx e1.etype ctx.t.tint e1.epos; - ctx.t.tint - | KInt, KAbstract _ -> - unify ctx e2.etype ctx.t.tint e2.epos; - ctx.t.tint - | KAbstract _,_ - | _,KAbstract _ - | KNumParam _, _ - | _, KNumParam _ - | KOther, _ - | _ , KOther -> - let pr = print_context() in - error ("Cannot add " ^ s_type pr e1.etype ^ " and " ^ s_type pr e2.etype) p - ) - | OpAnd - | OpOr - | OpXor - | OpShl - | OpShr - | OpUShr -> - let i = tint in - unify ctx e1.etype i e1.epos; - unify ctx e2.etype i e2.epos; - mk_op e1 e2 i - | OpMod - | OpMult - | OpDiv - | OpSub -> - let result = ref (if op = OpDiv then tfloat else tint) in - (match classify e1.etype, classify e2.etype with - | KFloat, KFloat -> - result := tfloat - | KNumParam t1, KNumParam t2 when Type.type_iseq t1 t2 -> - if op <> OpDiv then result := t1 - | KNumParam _, KNumParam _ -> - result := tfloat - | KNumParam t, KInt | KInt, KNumParam t -> - if op <> OpDiv then result := t - | KNumParam _, KFloat | KFloat, KNumParam _ -> - result := tfloat - | KFloat, k -> - ignore(unify_int ctx e2 k); - result := tfloat - | k, KFloat -> - ignore(unify_int ctx e1 k); - result := tfloat - | k1 , k2 -> - let ok1 = unify_int ctx e1 k1 in - let ok2 = unify_int ctx e2 k2 in - if not ok1 || not ok2 then result := tfloat; - ); - mk_op e1 e2 !result - | OpEq - | OpNotEq -> - let e1,e2 = try - (* we only have to check one type here, because unification fails if one is Void and the other is not *) - (match follow e2.etype with TAbstract({a_path=[],"Void"},_) -> error "Cannot compare Void" p | _ -> ()); - AbstractCast.cast_or_unify_raise ctx e2.etype e1 p,e2 - with Error (Unify _,_) -> - e1,AbstractCast.cast_or_unify ctx e1.etype e2 p - in - if not ctx.com.config.pf_supports_function_equality then begin match e1.eexpr, e2.eexpr with - | TConst TNull , _ | _ , TConst TNull -> () - | _ -> - match follow e1.etype, follow e2.etype with - | TFun _ , _ | _, TFun _ -> ctx.com.warning "Comparison of function values is unspecified on this target, use Reflect.compareMethods instead" p - | _ -> () - end; - mk_op e1 e2 ctx.t.tbool - | OpGt - | OpGte - | OpLt - | OpLte -> - (match classify e1.etype, classify e2.etype with - | KInt , KInt | KInt , KFloat | KFloat , KInt | KFloat , KFloat | KString , KString -> () - | KInt , KUnk -> ignore(unify_int ctx e2 KUnk) - | KFloat , KUnk | KString , KUnk -> unify ctx e2.etype e1.etype e2.epos - | KUnk , KInt -> ignore(unify_int ctx e1 KUnk) - | KUnk , KFloat | KUnk , KString -> unify ctx e1.etype e2.etype e1.epos - | KUnk , KUnk -> - ignore(unify_int ctx e1 KUnk); - ignore(unify_int ctx e2 KUnk); - | KDyn , KInt | KDyn , KFloat | KDyn , KString -> () - | KInt , KDyn | KFloat , KDyn | KString , KDyn -> () - | KDyn , KDyn -> () - | KNumParam _ , (KInt | KFloat | KNumParam _ | KDyn | KUnk ) -> () - | (KInt | KFloat | KDyn | KUnk ), KNumParam _ -> () - | KStrParam _ , (KString | KStrParam _ | KUnk | KDyn) -> () - | (KString | KUnk | KDyn) , KStrParam _ -> () - | KAbstract _,_ - | _,KAbstract _ - | KDyn , KUnk - | KUnk , KDyn - | KString , KInt - | KString , KFloat - | KInt , KString - | KFloat , KString - | KNumParam _ , _ - | _ , KNumParam _ - | KStrParam _ , _ - | _ , KStrParam _ - | KOther , _ - | _ , KOther -> - let pr = print_context() in - error ("Cannot compare " ^ s_type pr e1.etype ^ " and " ^ s_type pr e2.etype) p - ); - mk_op e1 e2 ctx.t.tbool - | OpBoolAnd - | OpBoolOr -> - let b = ctx.t.tbool in - unify ctx e1.etype b p; - unify ctx e2.etype b p; - mk_op e1 e2 b - | OpInterval -> - let t = Typeload.load_core_type ctx "IntIterator" in - unify ctx e1.etype tint e1.epos; - unify ctx e2.etype tint e2.epos; - mk (TNew ((match t with TInst (c,[]) -> c | _ -> die "" __LOC__),[],[e1;e2])) t p - | OpArrow -> - error "Unexpected =>" p - | OpIn -> - error "Unexpected in" p - | OpAssign - | OpAssignOp _ -> - die "" __LOC__ - in - let find_overload a c tl left = - let map = apply_params a.a_params tl in - let make op_cf cf e1 e2 tret = - if cf.cf_expr = None then begin - if not (Meta.has Meta.NoExpr cf.cf_meta) then display_error ctx "Recursive operator method" p; - if not (Meta.has Meta.CoreType a.a_meta) then begin - (* for non core-types we require that the return type is compatible to the native result type *) - let e' = make {e1 with etype = Abstract.follow_with_abstracts e1.etype} {e1 with etype = Abstract.follow_with_abstracts e2.etype} in - let t_expected = e'.etype in - begin try - unify_raise ctx tret t_expected p - with Error (Unify _,_) -> - match follow tret with - | TAbstract(a,tl) when type_iseq (Abstract.get_underlying_type a tl) t_expected -> - () - | _ -> - let st = s_type (print_context()) in - error (Printf.sprintf "The result of this operation (%s) is not compatible with declared return type %s" (st t_expected) (st tret)) p - end; - end; - let e = Texpr.Builder.binop op e1 e2 tret p in - mk_cast e tret p - end else begin - let e = make_static_call ctx c cf map [e1;e2] tret p in - e - end - in - (* special case for == and !=: if the second type is a monomorph, assume that we want to unify - it with the first type to preserve comparison semantics. *) - let is_eq_op = match op with OpEq | OpNotEq -> true | _ -> false in - if is_eq_op then begin match follow e1.etype,follow e2.etype with - | TMono _,_ | _,TMono _ -> - Type.unify e1.etype e2.etype - | _ -> - () - end; - let rec loop ol = match ol with - | (op_cf,cf) :: ol when op_cf <> op && (not is_assign_op || op_cf <> OpAssignOp(op)) -> - loop ol - | (op_cf,cf) :: ol -> - let is_impl = Meta.has Meta.Impl cf.cf_meta in - begin match follow cf.cf_type with - | TFun([(_,_,t1);(_,_,t2)],tret) -> - let check e1 e2 swapped = - let map_arguments () = - let monos = List.map (fun _ -> mk_mono()) cf.cf_params in - let map t = map (apply_params cf.cf_params monos t) in - let t1 = map t1 in - let t2 = map t2 in - let tret = map tret in - monos,t1,t2,tret - in - let monos,t1,t2,tret = map_arguments() in - let make e1 e2 = make op_cf cf e1 e2 tret in - let t1 = if is_impl then Abstract.follow_with_abstracts t1 else t1 in - let e1,e2 = if left || not left && swapped then begin - Type.type_eq EqStrict (if is_impl then Abstract.follow_with_abstracts e1.etype else e1.etype) t1; - e1,AbstractCast.cast_or_unify_raise ctx t2 e2 p - end else begin - Type.type_eq EqStrict e2.etype t2; - AbstractCast.cast_or_unify_raise ctx t1 e1 p,e2 - end in - check_constraints ctx "" cf.cf_params monos (apply_params a.a_params tl) false cf.cf_pos; - let check_null e t = if is_eq_op then match e.eexpr with - | TConst TNull when not (is_explicit_null t) -> raise (Unify_error []) - | _ -> () - in - (* If either expression is `null` we only allow operator resolving if the argument type - is explicitly Null (issue #3376) *) - if is_eq_op then begin - check_null e2 t2; - check_null e1 t1; - end; - let e = if not swapped then - make e1 e2 - else if not (OptimizerTexpr.has_side_effect e1) && not (OptimizerTexpr.has_side_effect e2) then - make e1 e2 - else - let v1,v2 = gen_local ctx t1 e1.epos, gen_local ctx t2 e2.epos in - let ev1,ev2 = mk (TVar(v1,Some e1)) ctx.t.tvoid p,mk (TVar(v2,Some e2)) ctx.t.tvoid p in - let eloc1,eloc2 = mk (TLocal v1) v1.v_type p,mk (TLocal v2) v2.v_type p in - let e = make eloc1 eloc2 in - let e = mk (TBlock [ - ev2; - ev1; - e - ]) e.etype e.epos in - e - in - if is_assign_op && op_cf = op then (mk (TMeta((Meta.RequiresAssign,[],p),e)) e.etype e.epos) - else e - in - begin try - check e1 e2 false - with Error (Unify _,_) | Unify_error _ -> try - if not (Meta.has Meta.Commutative cf.cf_meta) then raise Not_found; - check e2 e1 true - with Not_found | Error (Unify _,_) | Unify_error _ -> - loop ol - end - | _ -> - die "" __LOC__ - end - | [] -> - raise Not_found - in - if left then - loop a.a_ops - else - let not_impl_or_is_commutative (_, cf) = - not (Meta.has Meta.Impl cf.cf_meta) || Meta.has Meta.Commutative cf.cf_meta - in - loop (List.filter not_impl_or_is_commutative a.a_ops) - in +and type_ident ctx i p mode with_type = try - begin match follow e1.etype with - | TAbstract({a_impl = Some c} as a,tl) -> find_overload a c tl true - | _ -> raise Not_found - end - with Not_found -> try - begin match follow e2.etype with - | TAbstract({a_impl = Some c} as a,tl) -> find_overload a c tl false - | _ -> raise Not_found - end - with Not_found -> - if abstract_overload_only then raise Not_found - else make e1 e2 - -and type_unop ctx op flag e p = - let set = (op = Increment || op = Decrement) in - let acc = type_access ctx (fst e) (snd e) (if set then MSet else MGet) in - let access e = - let make e = - let t = (match op with - | Not -> - if flag = Postfix then error "Postfix ! is not supported" p; - unify ctx e.etype ctx.t.tbool e.epos; - ctx.t.tbool - | NegBits -> - unify ctx e.etype ctx.t.tint e.epos; - ctx.t.tint - | Increment - | Decrement - | Neg -> - if set then check_assign ctx e; - (match classify e.etype with - | KFloat -> ctx.t.tfloat - | KNumParam t -> - unify ctx e.etype ctx.t.tfloat e.epos; - t - | k -> - if unify_int ctx e k then ctx.t.tint else ctx.t.tfloat) - ) in - mk (TUnop (op,flag,e)) t p - in - try (match follow e.etype with - | TAbstract ({a_impl = Some c} as a,pl) -> - let rec loop opl = match opl with - | [] -> raise Not_found - | (op2,flag2,cf) :: opl when op == op2 && flag == flag2 -> - let m = mk_mono() in - let tcf = apply_params a.a_params pl (monomorphs cf.cf_params cf.cf_type) in - if Meta.has Meta.Impl cf.cf_meta then begin - if type_iseq (tfun [apply_params a.a_params pl a.a_this] m) tcf then cf,tcf,m else loop opl - end else - if type_iseq (tfun [e.etype] m) tcf then cf,tcf,m else loop opl - | _ :: opl -> loop opl - in - let cf,t,r = try loop a.a_unops with Not_found -> raise Not_found in - (match cf.cf_expr with - | None -> - let e = {e with etype = apply_params a.a_params pl a.a_this} in - let e = mk (TUnop(op,flag,e)) r p in - (* unify ctx r e.etype p; *) (* TODO: I'm not sure why this was here (related to #2295) *) - e - | Some _ -> - let et = type_module_type ctx (TClassDecl c) None p in - let ef = mk (TField (et,FStatic (c,cf))) t p in - make_call ctx ef [e] r p) - | _ -> raise Not_found - ) with Not_found -> - make e - in - let rec loop acc = - match acc with - | AKExpr e -> access e - | AKInline _ | AKUsing _ when not set -> access (acc_get ctx acc p) - | AKNo s -> - error ("The field or identifier " ^ s ^ " is not accessible for " ^ (if set then "writing" else "reading")) p - | AKAccess(a,tl,c,ebase,ekey) -> - begin try - (match op with Increment | Decrement -> () | _ -> raise Not_found); - let v_key = alloc_var VGenerated "tmp" ekey.etype ekey.epos in - let evar_key = mk (TVar(v_key,Some ekey)) ctx.com.basic.tvoid ekey.epos in - let ekey = mk (TLocal v_key) ekey.etype ekey.epos in - (* get *) - let e_get = mk_array_get_call ctx (AbstractCast.find_array_access_raise ctx a tl ekey None p) c ebase p in - let v_get = alloc_var VGenerated "tmp" e_get.etype e_get.epos in - let ev_get = mk (TLocal v_get) v_get.v_type p in - let evar_get = mk (TVar(v_get,Some e_get)) ctx.com.basic.tvoid p in - (* op *) - let e_one = mk (TConst (TInt (Int32.of_int 1))) ctx.com.basic.tint p in - let e_op = mk (TBinop((if op = Increment then OpAdd else OpSub),ev_get,e_one)) ev_get.etype p in - (* set *) - let e_set = mk_array_set_call ctx (AbstractCast.find_array_access_raise ctx a tl ekey (Some e_op) p) c ebase p in - let el = evar_key :: evar_get :: e_set :: (if flag = Postfix then [ev_get] else []) in - mk (TBlock el) e_set.etype p - with Not_found -> - let e = mk_array_get_call ctx (AbstractCast.find_array_access ctx a tl ekey None p) c ebase p in - loop (AKExpr e) - end - | AKUsing (emethod,cl,cf,etarget,force_inline) when (op = Decrement || op = Increment) && has_meta Meta.Impl cf.cf_meta -> - let l = save_locals ctx in - let init_tmp,etarget,eget = - match needs_temp_var etarget, fst e with - | true, EField (_, field_name) -> - let tmp = gen_local ctx etarget.etype p in - let tmp_ident = (EConst (Ident tmp.v_name), p) in - ( - mk (TVar (tmp, Some etarget)) ctx.t.tvoid p, - mk (TLocal tmp) tmp.v_type p, - (EField (tmp_ident,field_name), p) - ) - | _ -> (mk (TBlock []) ctx.t.tvoid p, etarget, e) - in - let op = (match op with Increment -> OpAdd | Decrement -> OpSub | _ -> die "" __LOC__) in - let one = (EConst (Int "1"),p) in - (match follow cf.cf_type with - | TFun (_, t) -> - (match flag with - | Prefix -> - let get = type_binop ctx op eget one false WithType.value p in - unify ctx get.etype t p; - l(); - let call_setter = make_call ctx emethod [etarget; get] t ~force_inline p in - mk (TBlock [init_tmp; call_setter]) t p - | Postfix -> - let get = type_expr ctx eget WithType.value in - let tmp_value = gen_local ctx t p in - let plusone = type_binop ctx op (EConst (Ident tmp_value.v_name),p) one false WithType.value p in - unify ctx get.etype t p; - l(); - mk (TBlock [ - init_tmp; - mk (TVar (tmp_value,Some get)) ctx.t.tvoid p; - make_call ctx emethod [etarget; plusone] t ~force_inline p; - mk (TLocal tmp_value) t p; - ]) t p - ) - | _ -> - l(); - die "" __LOC__ - ) - | AKInline _ | AKUsing _ | AKMacro _ -> - error "This kind of operation is not supported" p - | AKFieldSet _ -> - error "Invalid operation" p - | AKSet (e,t,cf) -> - let l = save_locals ctx in - let v = gen_local ctx e.etype p in - let ev = mk (TLocal v) e.etype p in - let op = (match op with Increment -> OpAdd | Decrement -> OpSub | _ -> die "" __LOC__) in - let one = (EConst (Int "1"),p) in - let eget = (EField ((EConst (Ident v.v_name),p),cf.cf_name),p) in - match flag with - | Prefix -> - let get = type_binop ctx op eget one false WithType.value p in - unify ctx get.etype t p; - l(); - mk (TBlock [ - mk (TVar (v,Some e)) ctx.t.tvoid p; - make_call ctx (mk (TField (ev,quick_field_dynamic ev.etype ("set_" ^ cf.cf_name))) (tfun [t] t) p) [get] t p - ]) t p - | Postfix -> - let v2 = gen_local ctx t p in - let ev2 = mk (TLocal v2) t p in - let get = type_expr ctx eget WithType.value in - let plusone = type_binop ctx op (EConst (Ident v2.v_name),p) one false WithType.value p in - unify ctx get.etype t p; - l(); - mk (TBlock [ - mk (TVar (v,Some e)) ctx.t.tvoid p; - mk (TVar (v2,Some get)) ctx.t.tvoid p; - make_call ctx (mk (TField (ev,quick_field_dynamic ev.etype ("set_" ^ cf.cf_name))) (tfun [plusone.etype] t) p) [plusone] t p; - ev2 - ]) t p - in - loop acc - -and type_ident ctx i p mode = - try - type_ident_raise ctx i p mode + type_ident_raise ctx i p mode with_type with Not_found -> try (* lookup type *) if is_lower_ident i p then raise Not_found; @@ -1287,6 +453,7 @@ and type_ident ctx i p mode = raise (Error(err,p)) | DMDiagnostics _ -> DisplayToplevel.handle_unresolved_identifier ctx i p false; + DisplayFields.handle_missing_ident ctx i mode with_type p; let t = mk_mono() in AKExpr (mk (TIdent i) t p) | _ -> @@ -1299,7 +466,7 @@ and type_ident ctx i p mode = end end -and handle_efield ctx e p0 mode = +and handle_efield ctx e p0 mode with_type = let open TyperDotPath in let dot_path first pnext = @@ -1308,17 +475,17 @@ and handle_efield ctx e p0 mode = (* first, try to resolve the first ident in the chain and access its fields. this doesn't support untyped identifiers yet, because we want to check fully-qualified paths first (even in an untyped block) *) - field_chain ctx pnext (type_ident_raise ctx name p) + field_chain ctx pnext (type_ident_raise ctx name p MGet WithType.value) with Not_found -> (* first ident couldn't be resolved, it's probably a fully qualified path - resolve it *) let path = (first :: pnext) in try - resolve_dot_path ctx path + resolve_dot_path ctx path mode with_type with Not_found -> (* dot-path resolution failed, it could be an untyped field access that happens to look like a dot-path, e.g. `untyped __global__.String` *) try (* TODO: we don't really want to do full type_ident again, just the second part of it *) - field_chain ctx pnext (type_ident ctx name p) + field_chain ctx pnext (type_ident ctx name p MGet WithType.value) with Error (Unknown_ident _,p2) as e when p = p2 -> try (* try raising a more sensible error if there was an uppercase-first (module name) part *) @@ -1373,34 +540,41 @@ and handle_efield ctx e p0 mode = | _ -> (* non-ident expr occured: definitely NOT a fully-qualified access, resolve the field chain against this expression *) - let e = type_access ctx e p in + let e = type_access ctx e p MGet WithType.value in field_chain ctx dot_path_acc e in - loop [] (e,p0) mode + loop [] (e,p0) mode with_type -and type_access ctx e p mode = +and type_access ctx e p mode with_type = match e with | EConst (Ident s) -> - type_ident ctx s p mode + type_ident ctx s p mode with_type | EField (e1,"new") -> let e1 = type_expr ctx e1 WithType.value in begin match e1.eexpr with | TTypeExpr (TClassDecl c) -> - if mode = MSet then error "Cannot set constructor" p; - if mode = MCall then error ("Cannot call constructor like this, use 'new " ^ (s_type_path c.cl_path) ^ "()' instead") p; - let monos = List.map (fun _ -> mk_mono()) (match c.cl_kind with KAbstractImpl a -> a.a_params | _ -> c.cl_params) in - let ct, cf = get_constructor ctx c monos p in + begin match mode with + | MSet _ -> error "Cannot set constructor" p; + | MCall _ -> error ("Cannot call constructor like this, use 'new " ^ (s_type_path c.cl_path) ^ "()' instead") p; + | MGet -> () + end; + let monos = Monomorph.spawn_constrained_monos (fun t -> t) (match c.cl_kind with KAbstractImpl a -> a.a_params | _ -> c.cl_params) in + let fa = FieldAccess.get_constructor_access c monos p in + let cf = fa.fa_field in + no_abstract_constructor c p; check_constructor_access ctx c cf p; - let args = match follow ct with TFun(args,ret) -> args | _ -> die "" __LOC__ in + let args = match follow (FieldAccess.get_map_function fa cf.cf_type) with TFun(args,ret) -> args | _ -> die "" __LOC__ in let vl = List.map (fun (n,_,t) -> alloc_var VGenerated n t c.cl_pos) args in let vexpr v = mk (TLocal v) v.v_type p in let el = List.map vexpr vl in - let ec,t = match c.cl_kind with - | KAbstractImpl a -> - let e = type_module_type ctx (TClassDecl c) None p in - let e = mk (TField (e,(FStatic (c,cf)))) ct p in + let ec,t = match c.cl_kind, fa.fa_host with + | KAbstractImpl a, FHAbstract _ -> + let t = TAbstract(a,monos) in + (new call_dispatcher ctx (MCall []) WithType.value p)#field_call fa el [],t + | KAbstractImpl a, FHInstance (c,pl) -> + let e_new = mk (TNew(c,monos,el)) (TInst(c,pl)) p in let t = TAbstract(a,monos) in - make_call ctx e el t p,t + mk_cast e_new t p, t | _ -> let t = TInst(c,monos) in mk (TNew(c,monos,el)) t p,t @@ -1413,12 +587,11 @@ and type_access ctx e p mode = | _ -> error "Binding new is only allowed on class types" p end; | EField _ -> - handle_efield ctx e p mode + handle_efield ctx e p mode with_type | EArray (e1,e2) -> type_array_access ctx e1 e2 p mode | EDisplay (e,dk) -> - let resume_typing = type_expr ~mode in - AKExpr (TyperDisplay.handle_edisplay ~resume_typing ctx e dk WithType.value) + AKExpr (TyperDisplay.handle_edisplay ctx e dk mode WithType.value) | _ -> AKExpr (type_expr ~mode ctx (e,p) WithType.value) @@ -1428,25 +601,29 @@ and type_array_access ctx e1 e2 p mode = Calls.array_access ctx e1 e2 mode p and type_vars ctx vl p = - let vl = List.map (fun ((v,pv),final,t,e) -> + let vl = List.map (fun ev -> + let n = fst ev.ev_name + and pv = snd ev.ev_name in + DeprecationCheck.check_is ctx.com n ev.ev_meta pv; try - let t = Typeload.load_type_hint ctx p t in - let e = (match e with + let t = Typeload.load_type_hint ctx p ev.ev_type in + let e = (match ev.ev_expr with | None -> None | Some e -> let e = type_expr ctx e (WithType.with_type t) in let e = AbstractCast.cast_or_unify ctx t e p in Some e ) in - let v = add_local_with_origin ctx TVOLocalVariable v t pv in - if final then v.v_final <- true; + let v = add_local_with_origin ctx TVOLocalVariable n t pv in + v.v_meta <- ev.ev_meta; + if ev.ev_final then add_var_flag v VFinal; if ctx.in_display && DisplayPosition.display_position#enclosed_in pv then DisplayEmitter.display_variable ctx v pv; v,e with Error (e,p) -> check_error ctx e p; - add_local ctx VGenerated v t_dynamic pv, None (* TODO: What to do with this... *) + add_local ctx VGenerated n t_dynamic pv, None (* TODO: What to do with this... *) ) vl in delay ctx PTypeField (fun() -> List.iter @@ -1542,16 +719,16 @@ and format_string ctx s p = let slen = send - pos - 1 in let scode = String.sub s (pos + 1) slen in min := !min + 2; - if slen > 0 then begin + begin let e = let ep = { p with pmin = !pmin + pos + 2; pmax = !pmin + send + 1 } in - try - begin match ParserEntry.parse_expr_string ctx.com.defines scode ep error true with - | ParseSuccess(data,_,_) -> data - | ParseError(_,(msg,p),_) -> error (Parser.error_msg msg) p - end - with Exit -> - error "Invalid interpolated expression" ep + let error msg pos = + if Lexer.string_is_whitespace scode then error "Expression cannot be empty" ep + else error msg pos + in + match ParserEntry.parse_expr_string ctx.com.defines scode ep error true with + | ParseSuccess(data,_,_) -> data + | ParseError(_,(msg,p),_) -> error (Parser.error_msg msg) p in add_expr e slen end; @@ -1682,11 +859,11 @@ and type_object_decl ctx fl with_type p = | ODKWithStructure a when PMap.is_empty a.a_fields && !dynamic_parameter = None -> type_plain_fields() | ODKWithStructure a -> let t, fl = type_fields a.a_fields in - if !(a.a_status) = Opened then a.a_status := Closed; mk (TObjectDecl fl) t p | ODKWithClass (c,tl) -> - let t,ctor = get_constructor ctx c tl p in - let args = match follow t with + let fa = FieldAccess.get_constructor_access c tl p in + let ctor = fa.fa_field in + let args = match follow (FieldAccess.get_map_function fa ctor.cf_type) with | TFun(args,_) -> args | _ -> die "" __LOC__ in @@ -1751,16 +928,13 @@ and type_new ctx path el with_type force_inline p = | _ -> fst path, p end in - let unify_constructor_call c params f ct = match follow ct with - | TFun (args,r) -> - (try - let el,_,_ = unify_field_call ctx (FInstance(c,params,f)) el args r p false in - el - with Error (e,p) -> - display_error ctx (error_msg e) p; - []) - | _ -> - error "Constructor is not a function" p + let unify_constructor_call c fa = + try + let fcc = unify_field_call ctx fa [] el p fa.fa_inline in + check_constructor_access ctx c fcc.fc_field p; + fcc + with Error (e,p) -> + error (error_msg e) p; in let t = if (fst path).tparams <> [] then begin try @@ -1784,14 +958,12 @@ and type_new ctx path el with_type force_inline p = (* Try to infer generic parameters from the argument list (issue #2044) *) begin match resolve_typedef (Typeload.load_type_def ctx p (fst path)) with | TClassDecl ({cl_constructor = Some cf} as c) -> - let monos = List.map (fun _ -> mk_mono()) c.cl_params in - let ct, f = get_constructor ctx c monos p in - ignore (unify_constructor_call c monos f ct); + let monos = Monomorph.spawn_constrained_monos (fun t -> t) c.cl_params in + let fa = FieldAccess.get_constructor_access c monos p in + no_abstract_constructor c p; + ignore (unify_constructor_call c fa); begin try - let t = Generic.build_generic ctx c p monos in - let map = apply_params c.cl_params monos in - check_constraints ctx (s_type_path c.cl_path) c.cl_params monos map true p; - t + Generic.build_generic ctx c p monos with Generic.Generic_Exception _ as exc -> (* If we have an expected type, just use that (issue #3804) *) begin match with_type with @@ -1811,35 +983,35 @@ and type_new ctx path el with_type force_inline p = List.iter (fun e -> ignore(type_expr ctx e WithType.value)) el; raise exc in - DisplayEmitter.check_display_type ctx t (pos path); + DisplayEmitter.check_display_type ctx t path; let t = follow t in - let build_constructor_call c tl = - let ct, f = get_constructor ctx c tl p in - check_constructor_access ctx c f p; - (match f.cf_kind with - | Var { v_read = AccRequire (r,msg) } -> (match msg with Some msg -> error msg p | None -> error_require r p) - | _ -> ()); - let el = unify_constructor_call c tl f ct in - el,f,ct + let build_constructor_call ao c tl = + let fa = FieldAccess.get_constructor_access c tl p in + let fa = if force_inline then {fa with fa_inline = true} else fa in + let cf = fa.fa_field in + no_abstract_constructor c p; + begin match cf.cf_kind with + | Var { v_read = AccRequire (r,msg) } -> (match msg with Some msg -> error msg p | None -> error_require r p) + | _ -> () + end; + unify_constructor_call c fa in - try begin match t with + try begin match Abstract.follow_with_forward_ctor t with | TInst ({cl_kind = KTypeParameter tl} as c,params) -> if not (TypeloadCheck.is_generic_parameter ctx c) then error "Only generic type parameters can be constructed" p; begin match get_constructible_constraint ctx tl p with | None -> raise_error (No_constructor (TClassDecl c)) p | Some(tl,tr) -> - let el,_ = unify_call_args ctx el tl tr p false false in + let el,_ = unify_call_args ctx el tl tr p false false false in mk (TNew (c,params,el)) t p end | TAbstract({a_impl = Some c} as a,tl) when not (Meta.has Meta.MultiType a.a_meta) -> - let el,cf,ct = build_constructor_call c tl in - let ta = mk_anon ~fields:c.cl_statics (ref (Statics c)) in - let e = mk (TTypeExpr (TClassDecl c)) ta p in - let e = mk (TField (e,(FStatic (c,cf)))) ct p in - make_call ctx e el t ~force_inline p + let fcc = build_constructor_call (Some a) c tl in + { (fcc.fc_data()) with etype = t } | TInst (c,params) | TAbstract({a_impl = Some c},params) -> - let el,_,_ = build_constructor_call c params in + let fcc = build_constructor_call None c params in + let el = fcc.fc_args in mk (TNew (c,params,el)) t p | _ -> error (s_type (print_context()) t ^ " cannot be constructed") p @@ -1875,7 +1047,7 @@ and type_try ctx e1 catches with_type p = | [] -> () in - let check_catch_type_params params = + let check_catch_type_params params p = List.iter (fun pt -> if Abstract.follow_with_abstracts pt != t_dynamic then error "Catch class parameter must be Dynamic" p; ) params @@ -1887,10 +1059,10 @@ and type_try ctx e1 catches with_type p = | TInst ({ cl_kind = KTypeParameter _} as c,_) when not (TypeloadCheck.is_generic_parameter ctx c) -> error "Cannot catch non-generic type parameter" p | TInst (_,params) | TEnum (_,params) -> - check_catch_type_params params; + check_catch_type_params params (snd th); t | TAbstract(a,params) when Meta.has Meta.RuntimeValue a.a_meta -> - check_catch_type_params params; + check_catch_type_params params (snd th); t | TAbstract(a,tl) when not (Meta.has Meta.CoreType a.a_meta) -> loop (Abstract.get_underlying_type a tl) @@ -1906,7 +1078,7 @@ and type_try ctx e1 catches with_type p = let e = type_expr ctx e_ast with_type in (* If the catch position is the display position it means we get completion on the catch keyword or some punctuation. Otherwise we wouldn't reach this point. *) - if ctx.is_display_file && DisplayPosition.display_position#enclosed_in pc then ignore(TyperDisplay.display_expr ctx e_ast e DKMarked with_type pc); + if ctx.is_display_file && DisplayPosition.display_position#enclosed_in pc then ignore(TyperDisplay.display_expr ctx e_ast e DKMarked MGet with_type pc); v.v_type <- t2; locals(); ((v,e) :: acc1),(e :: acc2) @@ -1932,20 +1104,23 @@ and type_map_declaration ctx e1 el with_type p = | TInst({cl_path=["haxe";"ds"],"IntMap"},[tv]) -> ctx.t.tint,tv,true | TInst({cl_path=["haxe";"ds"],"StringMap"},[tv]) -> ctx.t.tstring,tv,true | TInst({cl_path=["haxe";"ds"],("ObjectMap" | "EnumValueMap")},[tk;tv]) -> tk,tv,true - | _ -> mk_mono(),mk_mono(),false + | _ -> spawn_monomorph ctx p,spawn_monomorph ctx p,false in match with_type with | WithType.WithType(t,_) -> get_map_params t - | _ -> (mk_mono(),mk_mono(),false) + | _ -> (spawn_monomorph ctx p,spawn_monomorph ctx p,false) in let keys = Hashtbl.create 0 in let check_key e_key = try let p = Hashtbl.find keys e_key.eexpr in display_error ctx "Duplicate key" e_key.epos; - error "Previously defined here" p + error (compl_msg "Previously defined here") p with Not_found -> - Hashtbl.add keys e_key.eexpr e_key.epos; + begin match e_key.eexpr with + | TConst _ -> Hashtbl.add keys e_key.eexpr e_key.epos; + | _ -> () + end in let el = e1 :: el in let el_kv = List.map (fun e -> match fst e with @@ -1972,13 +1147,8 @@ and type_map_declaration ctx e1 el with_type p = let e2 = type_expr ctx e2 WithType.value in (e1 :: el_k,e2 :: el_v) ) ([],[]) el_kv in - let unify_min_resume el = try - unify_min_raise ctx.com.basic el - with Error (Unify l,p) when ctx.in_call_args -> - raise (WithTypeError(Unify l,p)) - in - let tkey = unify_min_resume el_k in - let tval = unify_min_resume el_v in + let tkey = unify_min_raise ctx el_k in + let tval = unify_min_raise ctx el_v in el_k,el_v,tkey,tval end in let m = TypeloadModule.load_module ctx (["haxe";"ds"],"Map") null_pos in @@ -2004,7 +1174,6 @@ and type_local_function ctx kind f with_type p = if name = None then display_error ctx "Type parameters not supported in unnamed local functions" p; if with_type <> WithType.NoValue then error "Type parameters are not supported for rvalue functions" p end; - List.iter (fun tp -> if tp.tp_constraints <> None then display_error ctx "Type parameter constraints are not supported for local functions" p) f.f_params; let v,pname = (match name with | None -> None,p | Some (v,pn) -> Some v,pn @@ -2013,21 +1182,19 @@ and type_local_function ctx kind f with_type p = ctx.type_params <- params @ ctx.type_params; if not inline then ctx.in_loop <- false; let rt = Typeload.load_type_hint ctx p f.f_type in - let args = List.map (fun ((s,_),opt,_,t,c) -> - let t = Typeload.load_type_hint ctx p t in - let t, c = TypeloadFunction.type_function_arg ctx t c opt p in - s, c, t - ) f.f_args in + let type_arg opt t p = Typeload.load_type_hint ~opt ctx p t in + let args = new FunctionArguments.function_arguments ctx type_arg false ctx.in_display None f.f_args in + let targs = args#for_type in (match with_type with | WithType.WithType(t,_) -> let rec loop t = (match follow t with - | TFun (args2,tr) when List.length args2 = List.length args -> + | TFun (args2,tr) when List.length args2 = List.length targs -> List.iter2 (fun (_,_,t1) (_,_,t2) -> match follow t1 with | TMono _ -> unify ctx t2 t1 p | _ -> () - ) args args2; + ) targs args2; (* unify for top-down inference unless we are expecting Void *) begin match follow tr,follow rt with @@ -2044,12 +1211,12 @@ and type_local_function ctx kind f with_type p = if name = None then display_error ctx "Unnamed lvalue functions are not supported" p | _ -> ()); - let ft = TFun (fun_args args,rt) in + let ft = TFun (targs,rt) in let v = (match v with | None -> None | Some v -> let v = (add_local_with_origin ctx TVOLocalFunction v ft pname) in - if params <> [] then v.v_extra <- Some (params,None); + if params <> [] then v.v_extra <- Some (var_extra params None); Some v ) in let curfun = match ctx.curfun with @@ -2058,11 +1225,11 @@ and type_local_function ctx kind f with_type p = | FunMemberAbstractLocal -> FunMemberAbstractLocal | _ -> FunMemberClassLocal in - let e , fargs = TypeloadFunction.type_function ctx args rt curfun f ctx.in_display p in + let e = TypeloadFunction.type_function ctx args rt curfun f.f_expr ctx.in_display p in ctx.type_params <- old_tp; ctx.in_loop <- old_in_loop; let tf = { - tf_args = fargs; + tf_args = args#for_expr; tf_type = rt; tf_expr = e; } in @@ -2072,7 +1239,9 @@ and type_local_function ctx kind f with_type p = | Some v -> Typeload.generate_args_meta ctx.com None (fun m -> v.v_meta <- m :: v.v_meta) f.f_args; let open LocalUsage in - if params <> [] || inline then v.v_extra <- Some (params,if inline then Some e else None); + if params <> [] || inline then v.v_extra <- Some (var_extra params (if inline then Some e else None)); + if ctx.in_display && DisplayPosition.display_position#enclosed_in v.v_pos then + DisplayEmitter.display_variable ctx v v.v_pos; let rec loop = function | LocalUsage.Block f | LocalUsage.Loop f | LocalUsage.Function f -> f loop | LocalUsage.Use v2 | LocalUsage.Assign v2 when v == v2 -> raise Exit @@ -2146,7 +1315,7 @@ and type_array_decl ctx el with_type p = | None -> let el = List.map (fun e -> type_expr ctx e WithType.value) el in let t = try - unify_min_raise ctx.com.basic el + unify_min_raise ctx el with Error (Unify l,p) -> if !allow_array_dynamic || ctx.untyped || ctx.com.display.dms_error_policy = EPIgnore then t_dynamic @@ -2164,7 +1333,7 @@ and type_array_decl ctx el with_type p = mk (TArrayDecl el) (ctx.t.tarray t) p) and type_array_comprehension ctx e with_type p = - let v = gen_local ctx (mk_mono()) p in + let v = gen_local ctx (spawn_monomorph ctx p) p in let et = ref (EConst(Ident "null"),p) in let comprehension_pos = p in let rec map_compr (e,p) = @@ -2251,18 +1420,19 @@ and type_return ?(implicit=false) ctx e with_type p = mk (TReturn (Some e_null)) t_dynamic p and type_cast ctx e t p = + let tpos = pos t in let t = Typeload.load_complex_type ctx true t in let check_param pt = match follow pt with | TMono _ -> () (* This probably means that Dynamic wasn't bound (issue #4675). *) | t when t == t_dynamic -> () - | _ ->error "Cast type parameters must be Dynamic" p + | _ -> error "Cast type parameters must be Dynamic" tpos in let rec loop t = match follow t with | TInst (_,params) | TEnum (_,params) -> List.iter check_param params; (match follow t with | TInst (c,_) -> - (match c.cl_kind with KTypeParameter _ -> error "Can't cast to a type parameter" p | _ -> ()); + (match c.cl_kind with KTypeParameter _ -> error "Can't cast to a type parameter" tpos | _ -> ()); TClassDecl c | TEnum (e,_) -> TEnumDecl e | _ -> die "" __LOC__); @@ -2272,7 +1442,7 @@ and type_cast ctx e t p = | TAbstract (a,params) -> loop (Abstract.get_underlying_type a params) | _ -> - error "Cast type must be a class or an enum" p + error "Cast type must be a class or an enum" tpos in let texpr = loop t in mk (TCast (type_expr ctx e WithType.value,Some texpr)) t p @@ -2369,18 +1539,20 @@ and type_meta ?(mode=MGet) ctx m e1 with_type p = ctx.meta <- old; e -and type_call_target ctx e with_type inline p = - let e = maybe_type_against_enum ctx (fun () -> type_access ctx (fst e) (snd e) MCall) with_type true p in +and type_call_target ctx e el with_type inline p = + let e = maybe_type_against_enum ctx (fun () -> type_access ctx (fst e) (snd e) (MCall el) with_type) with_type true p in + let check_inline cf = + if (has_class_field_flag cf CfAbstract) then display_error ctx "Cannot force inline on abstract method" p + in if not inline then e else match e with - | AKExpr {eexpr = TField(e1,fa); etype = t} -> - begin match extract_field fa with - | Some cf -> AKInline(e1,cf,fa,t) - | None -> e - end; - | AKUsing(e,c,cf,ef,_) -> - AKUsing(e,c,cf,ef,true) + | AKField fa -> + check_inline fa.fa_field; + AKField({fa with fa_inline = true}) + | AKUsingField sea -> + check_inline sea.se_access.fa_field; + AKUsingField {sea with se_access = {sea.se_access with fa_inline = true}} | AKExpr {eexpr = TLocal _} -> display_error ctx "Cannot force inline on local functions" p; e @@ -2389,8 +1561,8 @@ and type_call_target ctx e with_type inline p = and type_call ?(mode=MGet) ctx e el (with_type:WithType.t) inline p = let def () = - let e = type_call_target ctx e with_type inline p in - build_call ~mode ctx e el with_type p + let e = type_call_target ctx e el with_type inline p in + build_call ~mode ctx e el with_type p; in match e, el with | (EConst (Ident "trace"),p) , e :: el -> @@ -2432,10 +1604,18 @@ and type_call ?(mode=MGet) ctx e el (with_type:WithType.t) inline p = e | (EField(e,"match"),p), [epat] -> let et = type_expr ctx e WithType.value in - (match follow et.etype with - | TEnum _ -> - Matcher.Match.match_expr ctx e [[epat],None,Some (EConst(Ident "true"),p),p] (Some (Some (EConst(Ident "false"),p),p)) (WithType.with_type ctx.t.tbool) true p - | _ -> def ()) + let rec has_enum_match t = match follow t with + | TEnum _ -> true + | TAbstract (a,tl) when (Meta.has Meta.Forward a.a_meta) && not (Meta.has Meta.CoreType a.a_meta) -> + (match a.a_impl with + | Some c when (PMap.exists "match" c.cl_statics) && (has_class_field_flag (PMap.find "match" c.cl_statics) CfImpl) -> false + | _ -> has_enum_match (Abstract.get_underlying_type ~return_first:true a tl)) + | _ -> false + in + if has_enum_match et.etype then + Matcher.Match.match_expr ctx e [[epat],None,Some (EConst(Ident "true"),p),p] (Some (Some (EConst(Ident "false"),p),p)) (WithType.with_type ctx.t.tbool) true p + else + def () | (EConst (Ident "__unprotect__"),_) , [(EConst (String _),_) as e] -> let e = type_expr ctx e WithType.value in if Common.platform ctx.com Flash then @@ -2445,22 +1625,21 @@ and type_call ?(mode=MGet) ctx e el (with_type:WithType.t) inline p = else e | (EDisplay((EConst (Ident "super"),_ as e1),dk),_),_ -> - TyperDisplay.handle_display ctx (ECall(e1,el),p) dk with_type + TyperDisplay.handle_display ctx (ECall(e1,el),p) dk mode with_type | (EConst (Ident "super"),sp) , el -> if ctx.curfun <> FunConstructor then error "Cannot call super constructor outside class constructor" p; let el, t = (match ctx.curclass.cl_super with | None -> error "Current class does not have a super" p | Some (c,params) -> - let ct, f = get_constructor ctx c params p in - if (Meta.has Meta.CompilerGenerated f.cf_meta) then display_error ctx (error_msg (No_constructor (TClassDecl c))) p; - let el = (match follow ct with - | TFun (args,r) -> - let el,_,_ = unify_field_call ctx (FInstance(c,params,f)) el args r p false in - el - | _ -> - error "Constructor is not a function" p - ) in - el , TInst (c,params) + let fa = FieldAccess.get_constructor_access c params p in + let cf = fa.fa_field in + let t = TInst (c,params) in + let e = mk (TConst TSuper) t sp in + if (Meta.has Meta.CompilerGenerated cf.cf_meta) then display_error ctx (error_msg (No_constructor (TClassDecl c))) p; + let fa = FieldAccess.create e cf (FHInstance(c,params)) false p in + let fcc = unify_field_call ctx fa [] el p false in + let el = fcc.fc_args in + el,t ) in mk (TCall (mk (TConst TSuper) t sp,el)) ctx.t.tvoid p | _ -> @@ -2475,17 +1654,17 @@ and type_expr ?(mode=MGet) ctx (e,p) (with_type:WithType.t) = error "Field names starting with $ are not allowed" p | EConst (Ident s) -> if s = "super" && with_type <> WithType.NoValue && not ctx.in_display then error "Cannot use super as value" p; - let e = maybe_type_against_enum ctx (fun () -> type_ident ctx s p mode) with_type false p in + let e = maybe_type_against_enum ctx (fun () -> type_ident ctx s p mode with_type) with_type false p in acc_get ctx e p | EField _ | EArray _ -> - acc_get ctx (type_access ctx e p mode) p + acc_get ctx (type_access ctx e p mode with_type) p | EConst (Regexp (r,opt)) -> let str = mk (TConst (TString r)) ctx.t.tstring p in let opt = mk (TConst (TString opt)) ctx.t.tstring p in let t = Typeload.load_core_type ctx "EReg" in mk (TNew ((match t with TInst (c,[]) -> c | _ -> die "" __LOC__),[],[str;opt])) t p - | EConst (String(s,_)) when s <> "" && Lexer.is_fmt_string p -> + | EConst (String(s,SSingleQuotes)) when s <> "" -> type_expr ctx (format_string ctx s p) with_type | EConst c -> Texpr.type_constant ctx.com.basic c p @@ -2588,13 +1767,13 @@ and type_expr ?(mode=MGet) ctx (e,p) (with_type:WithType.t) = type_try ctx e1 catches with_type p | EThrow e -> let e = type_expr ctx e WithType.value in - mk (TThrow e) (mk_mono()) p + mk (TThrow e) (spawn_monomorph ctx p) p | ECall (e,el) -> type_call ~mode ctx e el with_type false p | ENew (t,el) -> type_new ctx t el with_type false p | EUnop (op,flag,e) -> - type_unop ctx op flag e p + type_unop ctx op flag e with_type p | EFunction (kind,f) -> type_local_function ctx kind f with_type p | EUntyped e -> @@ -2610,11 +1789,11 @@ and type_expr ?(mode=MGet) ctx (e,p) (with_type:WithType.t) = } | ECast (e,None) -> let e = type_expr ctx e WithType.value in - mk (TCast (e,None)) (mk_mono()) p + mk (TCast (e,None)) (spawn_monomorph ctx p) p | ECast (e, Some t) -> type_cast ctx e t p | EDisplay (e,dk) -> - TyperDisplay.handle_edisplay ctx e dk with_type + TyperDisplay.handle_edisplay ctx e dk mode with_type | EDisplayNew t -> die "" __LOC__ | ECheckType (e,t) -> @@ -2624,6 +1803,26 @@ and type_expr ?(mode=MGet) ctx (e,p) (with_type:WithType.t) = if e.etype == t then e else mk (TCast (e,None)) t p | EMeta (m,e1) -> type_meta ~mode ctx m e1 with_type p + | EIs (e,(t,p_t)) -> + match t with + | CTPath tp -> + if tp.tparams <> [] then display_error ctx "Type parameters are not supported for the `is` operator" p_t; + let e = type_expr ctx e WithType.value in + let e_t = type_type ctx (tp.tpackage,tp.tname) p_t in + let e_Std_isOfType = + match Typeload.load_type_raise ctx ([],"Std") "Std" p with + | TClassDecl c -> + let cf = + try PMap.find "isOfType" c.cl_statics + with Not_found -> die "" __LOC__ + in + Texpr.Builder.make_static_field c cf (mk_zero_range_pos p) + | _ -> die "" __LOC__ + in + mk (TCall (e_Std_isOfType, [e; e_t])) ctx.com.basic.tbool p + | _ -> + display_error ctx "Unsupported type for `is` operator" p_t; + Texpr.Builder.make_bool ctx.com.basic false p (* ---------------------------------------------------------------------- *) (* TYPER INITIALIZATION *) @@ -2693,6 +1892,11 @@ let rec create com = opened = []; vthis = None; in_call_args = false; + in_overload_call_args = false; + delayed_display = None; + monomorphs = { + perfunction = []; + }; on_error = (fun ctx msg p -> ctx.com.error msg p); memory_marker = Typecore.memory_marker; } in @@ -2769,6 +1973,6 @@ let rec create com = unify_min_ref := unify_min; unify_min_for_type_source_ref := unify_min_for_type_source; make_call_ref := make_call; -build_call_ref := build_call; type_call_target_ref := type_call_target; +type_access_ref := type_access; type_block_ref := type_block diff --git a/src/typing/typerBase.ml b/src/typing/typerBase.ml index feccd86f..55bfeb75 100644 --- a/src/typing/typerBase.ml +++ b/src/typing/typerBase.ml @@ -5,64 +5,31 @@ open Typecore open Error type access_kind = + (* Access is not possible or allowed. *) | AKNo of string + (* Access on arbitrary expression. *) | AKExpr of texpr - | AKSet of texpr * t * tclass_field - | AKInline of texpr * tclass_field * tfield_access * t - | AKMacro of texpr * tclass_field - | AKUsing of texpr * tclass * tclass_field * texpr * bool (* forced inline *) + (* Access on non-property field. *) + | AKField of field_access + (* Access on property field. The field is the property, not the accessor. *) + | AKAccessor of field_access + (* Access via static extension. *) + | AKUsingField of static_extension_access + (* Access via static extension on property field. The field is the property, not the accessor. + This currently only happens on abstract properties. *) + | AKUsingAccessor of static_extension_access + (* Access on abstract via array overload. *) | AKAccess of tabstract * tparams * tclass * texpr * texpr - | AKFieldSet of texpr * texpr * string * t + (* Access on abstract via resolve method. *) + | AKResolve of static_extension_access * string type object_decl_kind = | ODKWithStructure of tanon | ODKWithClass of tclass * tparams | ODKPlain -let build_call_ref : (typer -> access_kind -> expr list -> WithType.t -> pos -> texpr) ref = ref (fun _ _ _ _ _ -> die "" __LOC__) -let type_call_target_ref : (typer -> expr -> WithType.t -> bool -> pos -> access_kind) ref = ref (fun _ _ _ _ _ -> die "" __LOC__) - -let relative_path ctx file = - let slashes path = String.concat "/" (ExtString.String.nsplit path "\\") in - let fpath = slashes (Path.get_full_path file) in - let fpath_lower = String.lowercase fpath in - let flen = String.length fpath_lower in - let rec loop = function - | [] -> file - | path :: l -> - let spath = String.lowercase (slashes path) in - let slen = String.length spath in - if slen > 0 && slen < flen && String.sub fpath_lower 0 slen = spath then String.sub fpath slen (flen - slen) else loop l - in - loop ctx.com.Common.class_path - -let mk_infos ctx p params = - let file = if ctx.in_macro then p.pfile else if Common.defined ctx.com Define.AbsolutePath then Path.get_full_path p.pfile else relative_path ctx p.pfile in - (EObjectDecl ( - (("fileName",null_pos,NoQuotes) , (EConst (String(file,SDoubleQuotes)) , p)) :: - (("lineNumber",null_pos,NoQuotes) , (EConst (Int (string_of_int (Lexer.get_error_line p))),p)) :: - (("className",null_pos,NoQuotes) , (EConst (String (s_type_path ctx.curclass.cl_path,SDoubleQuotes)),p)) :: - if ctx.curfield.cf_name = "" then - params - else - (("methodName",null_pos,NoQuotes), (EConst (String (ctx.curfield.cf_name,SDoubleQuotes)),p)) :: params - ) ,p) - -let rec is_pos_infos = function - | TMono r -> - (match r.tm_type with - | Some t -> is_pos_infos t - | _ -> false) - | TLazy f -> - is_pos_infos (lazy_type f) - | TType ({ t_path = ["haxe"] , "PosInfos" },[]) -> - true - | TType (t,tl) -> - is_pos_infos (apply_params t.t_params tl t.t_type) - | TAbstract({a_path=[],"Null"},[t]) -> - is_pos_infos t - | _ -> - false +let type_call_target_ref : (typer -> expr -> expr list -> WithType.t -> bool -> pos -> access_kind) ref = ref (fun _ _ _ _ _ -> die "" __LOC__) +let type_access_ref : (typer -> expr_def -> pos -> access_mode -> WithType.t -> access_kind) ref = ref (fun _ _ _ _ _ -> assert false) let is_lower_ident s p = try Ast.is_lower_ident s @@ -119,10 +86,10 @@ let rec type_module_type ctx t tparams p = let t_tmp = class_module_type c in mk (TTypeExpr (TClassDecl c)) (TType (t_tmp,[])) p | TEnumDecl e -> - let types = (match tparams with None -> List.map (fun _ -> mk_mono()) e.e_params | Some l -> l) in + let types = (match tparams with None -> Monomorph.spawn_constrained_monos (fun t -> t) e.e_params | Some l -> l) in mk (TTypeExpr (TEnumDecl e)) (TType (e.e_type,types)) p | TTypeDecl s -> - let t = apply_params s.t_params (List.map (fun _ -> mk_mono()) s.t_params) s.t_type in + let t = apply_params s.t_params (List.map (fun _ -> spawn_monomorph ctx p) s.t_params) s.t_type in DeprecationCheck.check_typedef ctx.com s p; (match follow t with | TEnum (e,params) -> @@ -143,23 +110,43 @@ let rec type_module_type ctx t tparams p = let type_type ctx tpath p = type_module_type ctx (Typeload.load_type_def ctx p (mk_type_path tpath)) None p -let mk_module_type_access ctx t p : access_mode -> access_kind = - let e = type_module_type ctx t None p in - (fun _ -> AKExpr e) +let mk_module_type_access ctx t p = + AKExpr (type_module_type ctx t None p) + +let s_field_access tabs fa = + let st = s_type (print_context()) in + let se = s_expr_pretty true "" false st in + let sfa = function + | FHStatic c -> Printf.sprintf "FHStatic(%s)" (s_type_path c.cl_path) + | FHInstance(c,tl) -> Printf.sprintf "FHInstance(%s, %s)" (s_type_path c.cl_path) (s_types tl) + | FHAbstract(a,tl,c) -> Printf.sprintf "FHAbstract(%s, %s, %s)" (s_type_path a.a_path) (s_types tl) (s_type_path c.cl_path) + | FHAnon -> Printf.sprintf "FHAnon" + in + Printer.s_record_fields tabs [ + "fa_on",se fa.fa_on; + "fa_field",fa.fa_field.cf_name; + "fa_host",sfa fa.fa_host; + "fa_inline",string_of_bool fa.fa_inline + ] + +let s_static_extension_access sea = + Printer.s_record_fields "" [ + "se_this",s_expr_pretty true "" false (s_type (print_context())) sea.se_this; + "se_access",s_field_access "\t" sea.se_access + ] let s_access_kind acc = let st = s_type (print_context()) in let se = s_expr_pretty true "" false st in - let sfa = s_field_access st in match acc with | AKNo s -> "AKNo " ^ s | AKExpr e -> "AKExpr " ^ (se e) - | AKSet(e,t,cf) -> Printf.sprintf "AKSet(%s, %s, %s)" (se e) (st t) cf.cf_name - | AKInline(e,cf,fa,t) -> Printf.sprintf "AKInline(%s, %s, %s, %s)" (se e) cf.cf_name (sfa fa) (st t) - | AKMacro(e,cf) -> Printf.sprintf "AKMacro(%s, %s)" (se e) cf.cf_name - | AKUsing(e1,c,cf,e2,b) -> Printf.sprintf "AKUsing(%s, %s, %s, %s, %b)" (se e1) (s_type_path c.cl_path) cf.cf_name (se e2) b + | AKField fa -> Printf.sprintf "AKField(%s)" (s_field_access "" fa) + | AKAccessor fa -> Printf.sprintf "AKAccessor(%s)" (s_field_access "" fa) + | AKUsingField sea -> Printf.sprintf "AKUsingField(%s)" (s_static_extension_access sea) + | AKUsingAccessor sea -> Printf.sprintf "AKUsingAccessor(%s)" (s_static_extension_access sea) | AKAccess(a,tl,c,e1,e2) -> Printf.sprintf "AKAccess(%s, [%s], %s, %s, %s)" (s_type_path a.a_path) (String.concat ", " (List.map st tl)) (s_type_path c.cl_path) (se e1) (se e2) - | AKFieldSet(_) -> "" + | AKResolve(_) -> "" let get_constructible_constraint ctx tl p = let extract_function t = match follow t with @@ -200,7 +187,7 @@ let unify_static_extension ctx e t p = if multitype_involed e.etype t then AbstractCast.cast_or_unify_raise ctx t e p else begin - Type.unify e.etype t; + Type.unify_custom {default_unification_context with allow_dynamic_to_cast = false} e.etype t; e end diff --git a/src/typing/typerDisplay.ml b/src/typing/typerDisplay.ml index 82e9071e..872f33f5 100644 --- a/src/typing/typerDisplay.ml +++ b/src/typing/typerDisplay.ml @@ -15,8 +15,10 @@ open Type open Typecore open TyperBase open Fields +open CallUnification open Calls open Error +open FieldAccess let convert_function_signature ctx values (args,ret) = match CompletionType.from_type (get_import_status ctx) ~values (TFun(args,ret)) with | CompletionType.CTFunction ctf -> ((args,ret),ctf) @@ -53,12 +55,12 @@ let completion_item_of_expr ctx e = Display.merge_core_doc ctx (TClassDecl c); let decl = decl_of_class c in let origin = match c.cl_kind,e1.eexpr with - | KAbstractImpl _,_ when Meta.has Meta.Impl cf.cf_meta -> Self decl + | KAbstractImpl _,_ when has_class_field_flag cf CfImpl -> Self decl | _,TMeta((Meta.StaticExtension,_,_),_) -> StaticExtension decl | _ -> Self decl in let make_ci = match c.cl_kind with - | KAbstractImpl a when Meta.has Meta.Enum cf.cf_meta -> make_ci_enum_abstract_field a + | KAbstractImpl a when has_class_field_flag cf CfEnum -> make_ci_enum_abstract_field a | _ -> make_ci_class_field in of_field {e with etype = te} origin cf CFSStatic make_ci @@ -99,7 +101,7 @@ let completion_item_of_expr ctx e = | TAnon an -> make_ci_anon an (tpair e.etype) | _ -> itexpr e end - | TNew(c,tl,_) -> + | TNew(c,tl,el) -> Display.merge_core_doc ctx (TClassDecl c); (* begin match fst e_ast with | EConst (Regexp (r,opt)) -> @@ -119,10 +121,12 @@ let completion_item_of_expr ctx e = let absent = match absent with [] -> [] | _ -> "\n\nInactive flags:\n\n" :: absent in (TInst(c,tl)),Some ("Regular expression\n\n" ^ (String.concat "\n" (present @ absent))) | _ -> *) - let t,cf = get_constructor ctx c tl e.epos in - let t = match follow t with + let fa = get_constructor_access c tl e.epos in + let fcc = unify_field_call ctx fa el [] e.epos false in + let cf = fcc.fc_field in + let t = match follow (FieldAccess.get_map_function fa cf.cf_type) with | TFun(args,_) -> TFun(args,TInst(c,tl)) - | _ -> t + | t -> t in make_ci_class_field (CompletionClassField.make cf CFSConstructor (Self (decl_of_class c)) true) (tpair ~values:(get_value_meta cf.cf_meta) t) (* end *) @@ -143,14 +147,27 @@ let get_expected_type ctx with_type = | None -> None | Some t -> let from_type = CompletionType.from_type (get_import_status ctx) in - Some (from_type t,from_type (Type.map follow (follow t))) + let t_followed = Type.map follow (follow t) in + let compatible = match t_followed with + | TInst(c,tl) when Meta.has Meta.StructInit c.cl_meta -> + let fields = Some (get_struct_init_anon_fields c tl) in + let ta = mk_anon ?fields (ref Closed) in + [from_type ta] + | _ -> + [] + in + Some { + expected_type = from_type t; + expected_type_followed = from_type t_followed; + compatible_types = compatible; + } let raise_toplevel ctx dk with_type (subject,psubject) = let expected_type = get_expected_type ctx with_type in DisplayToplevel.collect_and_raise ctx (match dk with DKPattern _ -> TKPattern psubject | _ -> TKExpr psubject) with_type (CRToplevel expected_type) (subject,psubject) psubject let display_dollar_type ctx p make_type = - let mono = mk_mono() in + let mono = spawn_monomorph ctx p in let doc = doc_from_string "Outputs type of argument as a warning and uses argument as value" in let arg = ["expression",false,mono] in begin match ctx.com.display.dms_kind with @@ -192,7 +209,7 @@ let rec handle_signature_display ctx e_ast with_type = | (t,doc,values) :: tl -> let keep (args,r) = begin try - let _ = unify_call_args' ctx el args r p false false in + let _ = unify_call_args ctx el args r p false false false in true with | Error(Call_error (Not_enough_arguments _),_) -> true @@ -218,9 +235,15 @@ let rec handle_signature_display ctx e_ast with_type = [loop tl,None,PMap.empty] | TInst (c,tl) | TAbstract({a_impl = Some c},tl) -> Display.merge_core_doc ctx (TClassDecl c); - let ct,cf = get_constructor ctx c tl p in - let tl = (ct,cf.cf_doc,get_value_meta cf.cf_meta) :: List.rev_map (fun cf' -> cf'.cf_type,cf.cf_doc,get_value_meta cf'.cf_meta) cf.cf_overloads in - tl + let fa = get_constructor_access c tl p in + let is_wacky_overload = not (has_class_field_flag fa.fa_field CfOverload) in + let map = FieldAccess.get_map_function fa in + let map_cf cf = + (* Ghetto overloads have their documentation on the main field. *) + let doc = if is_wacky_overload then fa.fa_field.cf_doc else cf.cf_doc in + map cf.cf_type,doc,get_value_meta cf.cf_meta + in + List.map map_cf (fa.fa_field :: fa.fa_field.cf_overloads) | _ -> [] in @@ -228,7 +251,7 @@ let rec handle_signature_display ctx e_ast with_type = | ECall(e1,el) -> let def () = try - acc_get ctx (!type_call_target_ref ctx e1 with_type false (pos e1)) (pos e1) + acc_get ctx (!type_call_target_ref ctx e1 el with_type false (pos e1)) (pos e1) with | Error (Unknown_ident "trace",_) -> let e = expr_of_type_path (["haxe";"Log"],"trace") p in @@ -262,7 +285,7 @@ let rec handle_signature_display ctx e_ast with_type = in handle_call tl el e1.epos | ENew(tpath,el) -> - let t = Typeload.load_instance ctx tpath true in + let t = Abstract.follow_with_forward_ctor (Typeload.load_instance ctx tpath true) in handle_call (find_constructor_types t) el (pos tpath) | EArray(e1,e2) -> let e1 = type_expr ctx e1 WithType.value in @@ -291,12 +314,28 @@ let rec handle_signature_display ctx e_ast with_type = end | _ -> error "Call expected" p -and display_expr ctx e_ast e dk with_type p = +and display_expr ctx e_ast e dk mode with_type p = let get_super_constructor () = match ctx.curclass.cl_super with | None -> error "Current class does not have a super" p | Some (c,params) -> - let _, f = get_constructor ctx c params p in - f,c + let fa = get_constructor_access c params p in + fa.fa_field,c + in + let maybe_expand_overload e e_on host cf = match mode with + | MCall el when cf.cf_overloads <> [] -> + let fa = FieldAccess.create e_on cf host false p in + let fcc = unify_field_call ctx fa [] el p false in + FieldAccess.get_field_expr {fa with fa_field = fcc.fc_field} FCall + | _ -> + e + in + (* If we display on a TField node that points to an overloaded field, let's try to unify the field call + in order to resolve the correct overload (issue #7753). *) + let e = match e.eexpr with + | TField(e1,FStatic(c,cf)) -> maybe_expand_overload e e1 (FHStatic c) cf + | TField(e1,(FInstance(c,tl,cf) | FClosure(Some(c,tl),cf))) -> maybe_expand_overload e e1 (FHInstance(c,tl)) cf + | TField(e1,(FAnon cf | FClosure(None,cf))) -> maybe_expand_overload e e1 FHAnon cf + | _ -> e in match ctx.com.display.dms_kind with | DMResolve _ | DMPackage -> @@ -321,7 +360,8 @@ and display_expr ctx e_ast e dk with_type p = Display.ReferencePosition.set (snd ti.mt_path,ti.mt_name_pos,symbol_of_module_type mt); | TNew(c,tl,_) -> begin try - let _,cf = get_constructor ctx c tl p in + let fa = get_constructor_access c tl p in + let cf = fa.fa_field in Display.ReferencePosition.set (snd c.cl_path,cf.cf_name_pos,SKConstructor cf); with Not_found -> () @@ -368,7 +408,8 @@ and display_expr ctx e_ast e dk with_type p = | TTypeExpr mt -> [(t_infos mt).mt_name_pos] | TNew(c,tl,_) -> begin try - let _,cf = get_constructor ctx c tl p in + let fa = get_constructor_access c tl p in + let cf = fa.fa_field in if Meta.has Meta.CoreApi c.cl_meta then begin let c' = ctx.g.do_load_core_class ctx c in begin match c'.cl_constructor with @@ -491,7 +532,7 @@ let handle_structure_display ctx e fields origin = | _ -> error "Expected object expression" p -let handle_display ?resume_typing ctx e_ast dk with_type = +let handle_display ctx e_ast dk mode with_type = let old = ctx.in_display,ctx.in_call_args in ctx.in_display <- true; ctx.in_call_args <- false; @@ -521,9 +562,7 @@ let handle_display ?resume_typing ctx e_ast dk with_type = | (EConst (Ident "_"),p),WithType.WithType(t,_) -> mk (TConst TNull) t p (* This is "probably" a bind skip, let's just use the expected type *) | (_,p),_ -> try - match resume_typing with - | None -> type_expr ctx e_ast with_type - | Some fn -> fn ctx e_ast with_type + type_expr ~mode ctx e_ast with_type with Error (Unknown_ident n,_) when ctx.com.display.dms_kind = DMDefault -> if dk = DKDot && is_legacy_completion ctx.com then raise (Parser.TypePath ([n],None,false,p)) else raise_toplevel ctx dk with_type (n,p) @@ -570,10 +609,11 @@ let handle_display ?resume_typing ctx e_ast dk with_type = begin try let mt = ctx.g.do_load_type_def ctx null_pos {tpackage=mt.pack;tname=mt.module_name;tsub=Some mt.name;tparams=[]} in begin match resolve_typedef mt with - | TClassDecl c when has_constructor c -> true - | TAbstractDecl {a_impl = Some c} -> - ignore(c.cl_build()); - PMap.mem "_new" c.cl_statics + | TClassDecl c -> has_constructor c + | TAbstractDecl a -> (match Abstract.follow_with_forward_ctor ~build:true (TAbstract(a,List.map snd a.a_params)) with + | TInst(c,_) -> has_constructor c + | TAbstract({a_impl = Some c},_) -> PMap.mem "_new" c.cl_statics + | _ -> false) | _ -> false end with _ -> @@ -611,13 +651,19 @@ let handle_display ?resume_typing ctx e_ast dk with_type = end; ctx.in_display <- fst old; ctx.in_call_args <- snd old; - display_expr ctx e_ast e dk with_type p + let f () = display_expr ctx e_ast e dk mode with_type p in + if ctx.in_overload_call_args then begin + try + f() + with DisplayException de -> + ctx.delayed_display <- Some de; + e + end else + f() -let handle_edisplay ?resume_typing ctx e dk with_type = +let handle_edisplay ctx e dk mode with_type = let handle_display ctx e dk with_type = - match resume_typing with - | Some resume_typing -> handle_display ~resume_typing ctx e dk with_type - | None -> handle_display ctx e dk with_type + handle_display ctx e dk mode with_type in match dk,ctx.com.display.dms_kind with | DKCall,(DMSignature | DMDefault) -> handle_signature_display ctx e with_type diff --git a/src/typing/typerDotPath.ml b/src/typing/typerDotPath.ml index 0720ac64..e5b8c462 100644 --- a/src/typing/typerDotPath.ml +++ b/src/typing/typerDotPath.ml @@ -39,28 +39,43 @@ let mk_dot_path_part s p : dot_path_part = let s_dot_path parts = String.concat "." (List.map (fun (s,_,_) -> s) parts) +(** resolve given path against module fields or raise Not_found *) +let resolve_module_field ctx m path p mode with_type = + match path, m.m_statics with + | [], _ | _, None -> + raise Not_found + | (name,_,p) :: path_rest, Some c -> + let f = PMap.find name c.cl_statics in (* raises Not_found *) + let e = type_module_type ctx (TClassDecl c) None p in + field_access ctx mode f (FHStatic c) e p, path_rest + let resolve_module_type ctx m name p = let t = Typeload.find_type_in_module m name in (* raises Not_found *) mk_module_type_access ctx t p -let resolve_in_module ctx m path p = - let mname = snd m.m_path in - match path with - | (sname,PUppercase,sp) :: path_rest -> - begin - try - resolve_module_type ctx m sname sp, path_rest - with Not_found -> +let resolve_in_module ctx m path p mode with_type = + try + (* first, try to find module-level static access *) + resolve_module_field ctx m path p mode with_type + with Not_found -> + (* if there was no module fields, resolve *) + let mname = snd m.m_path in + match path with + | (sname,PUppercase,sp) :: path_rest -> + begin + try + resolve_module_type ctx m sname sp, path_rest + with Not_found -> + resolve_module_type ctx m mname p, path + end + | _ -> resolve_module_type ctx m mname p, path - end - | _ -> - resolve_module_type ctx m mname p, path (** resolve given qualified module pack+name (and possibly next path part) or raise Not_found *) -let resolve_qualified ctx pack name next_path p = +let resolve_qualified ctx pack name next_path p mode with_type = try let m = Typeload.load_module ctx (pack,name) p in - resolve_in_module ctx m next_path p + resolve_in_module ctx m next_path p mode with_type with Error (Module_not_found mpath,_) when mpath = (pack,name) -> (* might be an instance of https://github.com/HaxeFoundation/haxe/issues/9150 so let's also check (pack,name) of a TYPE in the current module context ¯\_(ツ)_/¯ *) @@ -68,32 +83,31 @@ let resolve_qualified ctx pack name next_path p = mk_module_type_access ctx t p, next_path (** resolve the given unqualified name (and possibly next path part) or raise Not_found *) -let resolve_unqualified ctx name next_path p = +let resolve_unqualified ctx name next_path p mode with_type = try (* if there's a type with this name in current module context - try resolving against it *) let t = Typeload.find_type_in_current_module_context ctx [] name in (* raises Not_found *) begin (* - if there's further uppercase field access, it might be a this-package module access rather than static field access, + if there's further field access, it might be a this-package module access rather than static field access, so we try resolving a field first and fall back to find_in_unqualified_modules *) match next_path with - | (field,PUppercase,pfield) :: next_path -> + | (field,_,pfield) :: next_path -> let e = type_module_type ctx t None p in - let f = type_field (TypeFieldConfig.create true) ctx e field pfield in - ignore(f MCall); (* raises Not_found *) (* not necessarily a call, but prevent #2602 among others *) - f, next_path + let access = type_field (TypeFieldConfig.create true) ctx e field pfield mode with_type in + access, next_path | _ -> mk_module_type_access ctx t p, next_path end with Not_found -> (* otherwise run the unqualified module resolution mechanism and look into the modules *) - let f m ~resume = resolve_in_module ctx m next_path p in + let f m ~resume = resolve_in_module ctx m next_path p mode with_type in Typeload.find_in_unqualified_modules ctx name p f ~resume:true (* raise Not_found *) (** given a list of dot path parts, resolve it into access getter or raise Not_found *) -let resolve_dot_path ctx (path_parts : dot_path_part list) = +let resolve_dot_path ctx (path_parts : dot_path_part list) mode with_type = let rec loop pack_acc path = match path with | (_,PLowercase,_) as x :: path -> @@ -101,13 +115,18 @@ let resolve_dot_path ctx (path_parts : dot_path_part list) = loop (x :: pack_acc) path | (name,PUppercase,p) :: path -> + (* If this is the last part we want to use the actual mode. *) + let mode,with_type = match path with + | [] | [_] -> mode,with_type + | _ -> MGet,WithType.value + in (* part starts with uppercase - it's a module name - try resolving *) let accessor, path_rest = if pack_acc <> [] then let pack = List.rev_map (fun (x,_,_) -> x) pack_acc in - resolve_qualified ctx pack name path p + resolve_qualified ctx pack name path p mode with_type else - resolve_unqualified ctx name path p + resolve_unqualified ctx name path p mode with_type in (* if we get here (that is, Not_found is not raised) - we have something to resolve against *) field_chain ctx path_rest accessor diff --git a/std/Any.hx b/std/Any.hx index d5bc429d..36991709 100644 --- a/std/Any.hx +++ b/std/Any.hx @@ -31,6 +31,7 @@ to work with the actual value, it needs to be explicitly promoted to another type. **/ +@:forward.variance abstract Any(Dynamic) { @:noCompletion @:to extern inline function __promote():T return this; diff --git a/std/DateTools.hx b/std/DateTools.hx index b305659e..32d5a63a 100644 --- a/std/DateTools.hx +++ b/std/DateTools.hx @@ -98,7 +98,7 @@ class DateTools { case "Y": Std.string(d.getFullYear()); default: - throw "Date.format %" + e + "- not implemented yet."; + throw new haxe.exceptions.NotImplementedException("Date.format %" + e + "- not implemented yet."); } } diff --git a/std/EReg.hx b/std/EReg.hx index ba33b85b..c2d1ec43 100644 --- a/std/EReg.hx +++ b/std/EReg.hx @@ -45,7 +45,7 @@ class EReg { If `r` or `opt` are null, the result is unspecified. **/ public function new(r:String, opt:String) { - throw "Regular expressions are not implemented for this platform"; + throw new haxe.exceptions.NotImplementedException("Regular expressions are not implemented for this platform"); } /** diff --git a/std/Std.hx b/std/Std.hx index 03fe7a16..9d7dd90e 100644 --- a/std/Std.hx +++ b/std/Std.hx @@ -34,6 +34,7 @@ extern class Std { If `t` is a class or interface with `@:generic` meta, the result is `false`. **/ + @:deprecated('Std.is is deprecated. Use Std.isOfType instead.') static function is(v:Dynamic, t:Dynamic):Bool; /** diff --git a/std/StringTools.hx b/std/StringTools.hx index b30555a4..ce1a79fb 100644 --- a/std/StringTools.hx +++ b/std/StringTools.hx @@ -209,7 +209,11 @@ class StringTools { When `value` is `null`, the result is unspecified. **/ public static inline function contains(s:String, value:String):Bool { + #if (js && js_es >= 6) + return (cast s).includes(value); + #else return s.indexOf(value) != -1; + #end } /** @@ -219,24 +223,17 @@ class StringTools { If `start` is the empty String `""`, the result is true. **/ - public static #if (cs || java || python) inline #end function startsWith(s:String, start:String):Bool { + public static #if (cs || java || python || (js && js_es >= 6)) inline #end function startsWith(s:String, start:String):Bool { #if java return (cast s : java.NativeString).startsWith(start); #elseif cs return untyped s.StartsWith(start); - #elseif cpp - if (s.length < start.length) - return false; - var p0 = s.c_str(); - var p1 = start.c_str(); - for (i in 0...start.length) - if (p0.at(i) != p1.at(i)) - return false; - return true; #elseif hl return @:privateAccess (s.length >= start.length && s.bytes.compare(0, start.bytes, 0, start.length << 1) == 0); #elseif python return python.NativeStringTools.startswith(s, start); + #elseif (js && js_es >= 6) + return (cast s).startsWith(start); #else return (s.length >= start.length && s.lastIndexOf(start, 0) == 0); #end @@ -249,7 +246,7 @@ class StringTools { If `end` is the empty String `""`, the result is true. **/ - public static #if (cs || java || python) inline #end function endsWith(s:String, end:String):Bool { + public static #if (cs || java || python || (js && js_es >= 6)) inline #end function endsWith(s:String, end:String):Bool { #if java return (cast s : java.NativeString).endsWith(end); #elseif cs @@ -260,6 +257,8 @@ class StringTools { return @:privateAccess (slen >= elen && s.bytes.compare((slen - elen) << 1, end.bytes, 0, elen << 1) == 0); #elseif python return python.NativeStringTools.endswith(s, end); + #elseif (js && js_es >= 6) + return (cast s).endsWith(end); #else var elen = end.length; var slen = s.length; @@ -502,6 +501,45 @@ class StringTools { #end } + /** + Returns the character code at position `index` of String `s`, or an + end-of-file indicator at if `position` equals `s.length`. + + This method is faster than `String.charCodeAt()` on some platforms, but + the result is unspecified if `index` is negative or greater than + `s.length`. + + This operation is not guaranteed to work if `s` contains the `\0` + character. + **/ + public static #if !eval inline #end function unsafeCodeAt(s:String, index:Int):Int { + #if neko + return untyped __dollar__sget(s.__s, index); + #elseif cpp + return untyped s.cca(index); + #elseif flash + return untyped s.cca(index); + #elseif java + return cast(_charAt(s, index), Int); + #elseif cs + return cast(s[index], Int); + #elseif js + return (cast s).charCodeAt(index); + #elseif python + return python.internal.UBuiltins.ord(python.Syntax.arrayAccess(s, index)); + #elseif hl + return @:privateAccess s.bytes.getUI16(index << 1); + #elseif lua + #if lua_vanilla + return lua.NativeStringTools.byte(s, index + 1); + #else + return lua.lib.luautf8.Utf8.byte(s, index + 1); + #end + #else + return untyped s.cca(index); + #end + } + /** Returns an iterator of the char codes. diff --git a/std/UInt.hx b/std/UInt.hx index eca400e0..44634515 100644 --- a/std/UInt.hx +++ b/std/UInt.hx @@ -130,6 +130,7 @@ abstract UInt to Int from Int { @see https://haxe.org/manual/types-basic-types.html **/ +@:transitive abstract UInt(Int) from Int to Int { @:op(A + B) private static inline function add(a:UInt, b:UInt):UInt { return a.toInt() + b.toInt(); diff --git a/std/cpp/NativeArray.hx b/std/cpp/NativeArray.hx index 38c5c5bf..6810d9fe 100644 --- a/std/cpp/NativeArray.hx +++ b/std/cpp/NativeArray.hx @@ -64,6 +64,9 @@ extern class NativeArray { @:nativeStaticExtension static function zero(ioDestArray:Array, ?inFirst:Int, ?inElements:Int):Void; + @:nativeStaticExtension + static function removeAt(ioDestArray:Array, inIndex:Int):Void; + @:nativeStaticExtension static function memcmp(inArrayA:Array, inArrayB:Array):Int; diff --git a/std/cpp/NativeString.hx b/std/cpp/NativeString.hx index 7b91e7b6..52868fdb 100644 --- a/std/cpp/NativeString.hx +++ b/std/cpp/NativeString.hx @@ -36,6 +36,20 @@ extern class NativeString { return untyped __global__.String(inPtr.ptr, inLen); } + @:native("__hxcpp_parse_float") + public static function parseFloat(inString:String):Float; + + @:native("__hxcpp_parse_substr_float") + public static function parseSubstrFloat(inString:String,start:Int, length:Int):Float; + + // Will return 0 for invalid string + @:native("__hxcpp_parse_substr_int") + public static function parseInt(inString:String):Int; + + // Will return 0 for invalid string + @:native("__hxcpp_parse_substr_int") + public static function parseSubstrInt(inString:String,start:Int, length:Int):Int; + @:native("_hx_string_compare") static function compare(inString0:String, inString1:String):Int; diff --git a/std/cpp/Rest.hx b/std/cpp/Rest.hx new file mode 100644 index 00000000..f111b355 --- /dev/null +++ b/std/cpp/Rest.hx @@ -0,0 +1,25 @@ +/* + * Copyright (C)2005-2019 Haxe Foundation + * + * Permission is hereby granted, free of charge, to any person obtaining a + * copy of this software and associated documentation files (the "Software"), + * to deal in the Software without restriction, including without limitation + * the rights to use, copy, modify, merge, publish, distribute, sublicense, + * and/or sell copies of the Software, and to permit persons to whom the + * Software is furnished to do so, subject to the following conditions: + * + * The above copyright notice and this permission notice shall be included in + * all copies or substantial portions of the Software. + * + * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR + * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE + * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER + * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING + * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER + * DEALINGS IN THE SOFTWARE. + */ + +package cpp; + +abstract Rest(Array) {} \ No newline at end of file diff --git a/std/cpp/Stdio.hx b/std/cpp/Stdio.hx index 13e77a84..453edae0 100644 --- a/std/cpp/Stdio.hx +++ b/std/cpp/Stdio.hx @@ -22,8 +22,6 @@ package cpp; -import haxe.extern.Rest; - @:include("stdio.h") extern class Stdio { @:native("printf") diff --git a/std/cpp/_std/Std.hx b/std/cpp/_std/Std.hx index a0bdb73d..95458559 100644 --- a/std/cpp/_std/Std.hx +++ b/std/cpp/_std/Std.hx @@ -21,6 +21,7 @@ */ @:headerClassCode("\t\tstatic inline String string(String &s) { return s; }") @:coreApi class Std { + @:deprecated('Std.is is deprecated. Use Std.isOfType instead.') @:keep public static inline function is(v:Dynamic, t:Dynamic):Bool { return isOfType(v, t); } diff --git a/std/cpp/_std/Type.hx b/std/cpp/_std/Type.hx index e898a96b..2b71193d 100644 --- a/std/cpp/_std/Type.hx +++ b/std/cpp/_std/Type.hx @@ -143,10 +143,12 @@ enum ValueType { } } + @:native("__hxcpp_enum_eq") + extern private static function nativeEnumEq(a:Dynamic, b:Dynamic):Bool; + + #if !cppia inline #end public static function enumEq(a:T, b:T):Bool - untyped { - return a == b; - } + return nativeEnumEq(a,b); public static function enumConstructor(e:EnumValue):String { var value:cpp.EnumBase = cast e; diff --git a/std/cpp/_std/haxe/Exception.hx b/std/cpp/_std/haxe/Exception.hx index 355d7e52..4c244a7e 100644 --- a/std/cpp/_std/haxe/Exception.hx +++ b/std/cpp/_std/haxe/Exception.hx @@ -16,7 +16,7 @@ class Exception { @:noCompletion var __previousException:Null; static function caught(value:Any):Exception { - if(Std.is(value, Exception)) { + if(Std.isOfType(value, Exception)) { return value; } else { return new ValueException(value, null, value); diff --git a/std/cpp/_std/haxe/Int64.hx b/std/cpp/_std/haxe/Int64.hx index 1ed9d3d7..7672cc0a 100644 --- a/std/cpp/_std/haxe/Int64.hx +++ b/std/cpp/_std/haxe/Int64.hx @@ -28,7 +28,6 @@ import haxe.Int64Helper; @:include("cpp/Int64.h") @:native("cpp::Int64Struct") private extern class ___Int64 { - function get():cpp.Int64; @:native("_hx_int64_make") static function make(high:Int32, low:Int32):__Int64; @@ -136,6 +135,7 @@ private extern class ___Int64 { private typedef __Int64 = ___Int64; @:coreApi +@:transitive abstract Int64(__Int64) from __Int64 to __Int64 { public #if !cppia inline #end function copy():Int64 return this; @@ -144,6 +144,16 @@ abstract Int64(__Int64) from __Int64 to __Int64 { return __Int64.make(high, low); } + @:to + #if !cppia inline #end function toInt64():cpp.Int64 { + return cast this; + } + + @:from + static #if !cppia inline #end function ofInt64(x:cpp.Int64):Int64 { + return cast x; + } + @:from public static #if !cppia inline #end function ofInt(x:Int):Int64 { return __Int64.ofInt(x); diff --git a/std/cpp/_std/haxe/Utf8.hx b/std/cpp/_std/haxe/Utf8.hx index accd2da7..65b4420b 100644 --- a/std/cpp/_std/haxe/Utf8.hx +++ b/std/cpp/_std/haxe/Utf8.hx @@ -29,7 +29,7 @@ using cpp.NativeString; class Utf8 { var __s:Array; - public function new(?size:Null):Void { + public function new(?size:Int):Void { __s = new Array(); if (size != null && size > 0) cpp.NativeArray.reserve(__s, size); diff --git a/std/cpp/_std/sys/db/Sqlite.hx b/std/cpp/_std/sys/db/Sqlite.hx index abc4fd62..7ab12344 100644 --- a/std/cpp/_std/sys/db/Sqlite.hx +++ b/std/cpp/_std/sys/db/Sqlite.hx @@ -85,12 +85,10 @@ private class SqliteConnection implements Connection { public function commit() { request("COMMIT"); - startTransaction(); // match mysql usage } public function rollback() { request("ROLLBACK"); - startTransaction(); // match mysql usage } @:native("_hx_sqlite_connect") @@ -175,7 +173,7 @@ private class SqliteResultSet implements ResultSet { } public function getFieldsNames():Array { - return null; + throw new haxe.exceptions.NotImplementedException(); } @:native("_hx_sqlite_result_next") diff --git a/std/cpp/_std/sys/ssl/Certificate.hx b/std/cpp/_std/sys/ssl/Certificate.hx index 705f6732..ea7adcf0 100644 --- a/std/cpp/_std/sys/ssl/Certificate.hx +++ b/std/cpp/_std/sys/ssl/Certificate.hx @@ -30,7 +30,7 @@ class Certificate { var __x:Dynamic; @:allow(sys.ssl.Socket) - function new(x:Dynamic, ?h:Null) { + function new(x:Dynamic, ?h:Certificate) { __x = x; __h = h; } diff --git a/std/cpp/_std/sys/thread/Thread.hx b/std/cpp/_std/sys/thread/Thread.hx index 44c9cedf..f3c00982 100644 --- a/std/cpp/_std/sys/thread/Thread.hx +++ b/std/cpp/_std/sys/thread/Thread.hx @@ -22,37 +22,163 @@ package sys.thread; +abstract Thread(HaxeThread) from HaxeThread to HaxeThread { + public var events(get,never):EventLoop; + + public inline function sendMessage(msg:Dynamic):Void { + this.sendMessage(msg); + } + + public static inline function current():Thread { + return HaxeThread.current(); + } + + public static inline function create(job:()->Void):Thread { + return HaxeThread.create(job, false); + } + + public static inline function runWithEventLoop(job:()->Void):Void { + HaxeThread.runWithEventLoop(job); + } + + public static inline function createWithEventLoop(job:()->Void):Thread { + return HaxeThread.create(job, true); + } + + public static function readMessage(block:Bool):Dynamic { + return HaxeThread.readMessage(block); + } + + function get_events():EventLoop { + if(this.events == null) + throw new NoEventLoopException(); + return this.events; + } + + @:keep + static function initEventLoop() { + @:privateAccess HaxeThread.current().events = new EventLoop(); + } + + @:keep + static public function processEvents() { + HaxeThread.current().events.loop(); + } +} + @:callable @:coreType -private abstract ThreadHandle {} +private abstract NativeThreadHandle {} + +private typedef ThreadHandle = NativeThreadHandle; + + +private class HaxeThread { + static final threads = new Array<{thread:HaxeThread, handle:ThreadHandle}>(); + static final threadsMutex = new Mutex(); + static var mainThreadHandle:ThreadHandle = currentHandle(); + static var mainThread:HaxeThread = new HaxeThread(currentHandle()); + + public var events(default,null):Null; + public var handle:ThreadHandle; + final messages = new Deque(); -abstract Thread(ThreadHandle) { - inline function new(h:ThreadHandle):Void { - this = h; + static public function current():HaxeThread { + var handle = currentHandle(); + if(handle == mainThreadHandle) { + return mainThread; + } + threadsMutex.acquire(); + var thread = null; + for(item in threads) { + if(item.handle == handle) { + thread = item.thread; + break; + } + } + if(thread == null) { + thread = new HaxeThread(handle); + threads.push({thread:thread, handle:handle}); + } + threadsMutex.release(); + return thread; } - public inline function sendMessage(msg:Dynamic):Void { - untyped __global__.__hxcpp_thread_send(this, msg); + public static function create(job:()->Void, withEventLoop:Bool):Thread { + var item = {handle:null, thread:new HaxeThread(null)}; + threadsMutex.acquire(); + var index = threads.push(item); + threadsMutex.release(); + if(withEventLoop) + item.thread.events = new EventLoop(); + item.handle = createHandle(() -> { + if(item.thread.handle == null) { + item.handle = currentHandle(); + item.thread.handle = item.handle; + } + try { + job(); + if(withEventLoop) + item.thread.events.loop(); + } catch(e) { + dropThread(item, index); + throw e; + } + dropThread(item, index); + }); + item.thread.handle = item.handle; + return item.thread; } - public static inline function current():Thread { - return new Thread(untyped __global__.__hxcpp_thread_current()); + public static function runWithEventLoop(job:()->Void):Void { + var thread = current(); + if(thread.events == null) { + thread.events = new EventLoop(); + try { + job(); + thread.events.loop(); + thread.events = null; + } catch(e) { + thread.events = null; + throw e; + } + } else { + job(); + } } - public static inline function create(callb:Void->Void):Thread { - return new Thread(untyped __global__.__hxcpp_thread_create(callb)); + static function dropThread(item, probableIndex:Int) { + threadsMutex.acquire(); + if(threads[probableIndex] == item) { + threads.splice(probableIndex, 1); + } else { + for(i => item2 in threads) { + if(item2 == item) { + threads.splice(i, 1); + break; + } + } + } + threadsMutex.release(); } - public static function readMessage(block:Bool):Dynamic { - return untyped __global__.__hxcpp_thread_read_message(block); + function new(h:ThreadHandle):Void { + handle = h; + } + + public inline function sendMessage(msg:Dynamic):Void { + messages.add(msg); + } + + static #if !scriptable inline #end function currentHandle():ThreadHandle { + return untyped __global__.__hxcpp_thread_current(); } - @:op(A == B) - public inline function equals(other:Thread):Bool { - return getHandle() == other.getHandle(); + static #if !scriptable inline #end function createHandle(callb:Void->Void):ThreadHandle { + return untyped __global__.__hxcpp_thread_create(callb); } - private inline function getHandle():ThreadHandle { - return this; + public static #if !scriptable inline #end function readMessage(block:Bool):Dynamic { + return current().messages.pop(block); } } diff --git a/std/cpp/cppia/HostClasses.hx b/std/cpp/cppia/HostClasses.hx index d395145f..392e403e 100644 --- a/std/cpp/cppia/HostClasses.hx +++ b/std/cpp/cppia/HostClasses.hx @@ -41,14 +41,14 @@ class HostClasses { "cpp.NativeArray", "cpp.NativeString", "cpp.vm.Debugger", - "cpp.vm.Deque", + "sys.thread.Deque", + "sys.thread.Lock", + "sys.thread.Mutex", + "sys.thread.Thread", + "sys.thread.Tls", "cpp.vm.ExecutionTrace", "cpp.vm.Gc", - "cpp.vm.Lock", - "cpp.vm.Mutex", "cpp.vm.Profiler", - "cpp.vm.Thread", - "cpp.vm.Tls", "cpp.vm.Unsafe", "cpp.vm.WeakRef", "cpp.Object", @@ -184,6 +184,7 @@ class HostClasses { externs.set("sys.net._Socket.SocketOutput", true); externs.set("sys.ssl._Socket.SocketInput", true); externs.set("sys.ssl._Socket.SocketOutput", true); + externs.set("sys.thread._Thread.HaxeThread",true); externs.set("haxe.ds.TreeNode", true); externs.set("haxe.xml.XmlParserException", true); for (e in classes) diff --git a/std/cs/Syntax.hx b/std/cs/Syntax.hx new file mode 100644 index 00000000..176cb250 --- /dev/null +++ b/std/cs/Syntax.hx @@ -0,0 +1,56 @@ +/* + * Copyright (C)2005-2021 Haxe Foundation + * + * Permission is hereby granted, free of charge, to any person obtaining a + * copy of this software and associated documentation files (the "Software"), + * to deal in the Software without restriction, including without limitation + * the rights to use, copy, modify, merge, publish, distribute, sublicense, + * and/or sell copies of the Software, and to permit persons to whom the + * Software is furnished to do so, subject to the following conditions: + * + * The above copyright notice and this permission notice shall be included in + * all copies or substantial portions of the Software. + * + * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR + * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE + * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER + * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING + * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER + * DEALINGS IN THE SOFTWARE. + */ + +package cs; + +import haxe.Rest; + +/** + Generate C# syntax not directly supported by Haxe. + Use only at low-level when specific target-specific code-generation is required. +**/ +@:noClosure +extern class Syntax { + /** + Inject `code` directly into generated source. + + `code` must be a string constant. + + Additional `args` are supported to provide code interpolation, for example: + ```haxe + Syntax.code("System.Console.WriteLine({0} + {1})", "hi", 42); + ``` + will generate + ```haxe + System.Console.WriteLine("hi" + 42); + ``` + + Emits a compilation error if the count of `args` does not match the count of placeholders in `code`. + **/ + static function code(code:String, args:Rest):Dynamic; + + /** + Inject `code` directly into generated source. + The same as `cs.Syntax.code` except this one does not provide code interpolation. + **/ + static function plainCode(code:String):Dynamic; +} diff --git a/std/cs/_std/Std.hx b/std/cs/_std/Std.hx index 540d5578..c24b6aa5 100644 --- a/std/cs/_std/Std.hx +++ b/std/cs/_std/Std.hx @@ -24,6 +24,7 @@ import cs.Boot; import cs.Lib; @:coreApi @:nativeGen class Std { + @:deprecated('Std.is is deprecated. Use Std.isOfType instead.') public static inline function is(v:Dynamic, t:Dynamic):Bool { return isOfType(v, t); } diff --git a/std/cs/_std/haxe/Exception.hx b/std/cs/_std/haxe/Exception.hx index f801f5c4..785551b4 100644 --- a/std/cs/_std/haxe/Exception.hx +++ b/std/cs/_std/haxe/Exception.hx @@ -18,7 +18,7 @@ class Exception extends NativeException { @:noCompletion var __previousException:Null; static public function caught(value:Any):Exception { - if(Std.is(value, Exception)) { + if(Std.isOfType(value, Exception)) { return value; } else if(Std.isOfType(value, CsException)) { return new Exception((value:CsException).Message, null, value); diff --git a/std/cs/_std/haxe/Int64.hx b/std/cs/_std/haxe/Int64.hx index fd4d21f2..072b1cb0 100644 --- a/std/cs/_std/haxe/Int64.hx +++ b/std/cs/_std/haxe/Int64.hx @@ -29,6 +29,7 @@ import haxe.Int64Helper; private typedef __Int64 = cs.StdTypes.Int64; @:coreApi +@:transitive abstract Int64(__Int64) from __Int64 to __Int64 { public static inline function make(high:Int32, low:Int32):Int64 return new Int64((cast(high, __Int64) << 32) | (cast(low, __Int64) & (untyped __cs__('0xffffffffL') : Int64))); diff --git a/std/cs/_std/haxe/Rest.hx b/std/cs/_std/haxe/Rest.hx new file mode 100644 index 00000000..f4c28b20 --- /dev/null +++ b/std/cs/_std/haxe/Rest.hx @@ -0,0 +1,54 @@ +package haxe; + +import haxe.iterators.RestIterator; +import haxe.iterators.RestKeyValueIterator; +import cs.NativeArray; +import cs.system.Array as CsArray; + +private typedef NativeRest = #if erase_generics NativeArray #else NativeArray #end; + +@:coreApi +abstract Rest(NativeRest) { + public var length(get,never):Int; + inline function get_length():Int + return this.Length; + + @:from static public inline function of(array:Array):Rest + return new Rest(@:privateAccess array.__a); + + inline function new(a:NativeRest):Void + this = a; + + @:arrayAccess inline function get(index:Int):T + return (this[index] : T); // typecheck, otherwise it will be inlined as Dynamic with `-D erase-generics` + + @:to public function toArray():Array { + var result = new NativeRest(this.Length); + CsArray.Copy(this, 0, result, 0, this.Length); + return @:privateAccess Array.ofNative(result); + } + + public inline function iterator():RestIterator + return new RestIterator(this); + + public inline function keyValueIterator():RestKeyValueIterator + return new RestKeyValueIterator(this); + + public function append(item:T):Rest { + var result = new NativeRest(this.Length + 1); + CsArray.Copy(this, 0, result, 0, this.Length); + result[this.Length] = item; + return new Rest(result); + } + + public function prepend(item:T):Rest { + var result = new NativeRest(this.Length + 1); + CsArray.Copy(this, 0, result, 1, this.Length); + result[0] = item; + return new Rest(result); + } + + public function toString():String { + return toArray().toString(); + } +} \ No newline at end of file diff --git a/std/cs/_std/sys/net/Host.hx b/std/cs/_std/sys/net/Host.hx index fc2b10e3..033db22a 100644 --- a/std/cs/_std/sys/net/Host.hx +++ b/std/cs/_std/sys/net/Host.hx @@ -45,11 +45,18 @@ class Host { public function new(name:String):Void { host = name; - hostEntry = Dns.GetHostEntry(name); - for (i in 0...hostEntry.AddressList.Length) { - if (hostEntry.AddressList[i].AddressFamily == InterNetwork) { - ipAddress = hostEntry.AddressList[i]; - break; + try{ + hostEntry = Dns.GetHostEntry(host); + for (i in 0...hostEntry.AddressList.Length) { + if (hostEntry.AddressList[i].AddressFamily == InterNetwork) { + ipAddress = hostEntry.AddressList[i]; + break; + } + } + }catch (e:Dynamic){ + ipAddress = IPAddress.Any; + if (!IPAddress.TryParse(host, ipAddress)){ + throw "Unknown host."; } } } diff --git a/std/cs/_std/sys/net/Socket.hx b/std/cs/_std/sys/net/Socket.hx index f3e24f9a..a696fef1 100644 --- a/std/cs/_std/sys/net/Socket.hx +++ b/std/cs/_std/sys/net/Socket.hx @@ -33,6 +33,7 @@ import cs.system.net.sockets.SocketShutdown; import cs.system.net.sockets.SocketType; import cs.system.threading.Thread; import cs.system.net.sockets.Socket in NativeSocket; +import cs.types.UInt8; import haxe.io.Bytes; import haxe.io.Error; import haxe.io.Input; @@ -48,7 +49,14 @@ class Socket { public var custom:Dynamic; + /** + Creates a new unconnected socket. + **/ public function new():Void { + init(); + } + + private function init():Void { sock = new NativeSocket(AddressFamily.InterNetwork, SocketType.Stream, ProtocolType.Tcp); sock.Blocking = true; } diff --git a/std/cs/_std/sys/net/UdpSocket.hx b/std/cs/_std/sys/net/UdpSocket.hx new file mode 100644 index 00000000..b853d52a --- /dev/null +++ b/std/cs/_std/sys/net/UdpSocket.hx @@ -0,0 +1,99 @@ +/* + * Copyright (C)2005-2019 Haxe Foundation + * + * Permission is hereby granted, free of charge, to any person obtaining a + * copy of this software and associated documentation files (the "Software"), + * to deal in the Software without restriction, including without limitation + * the rights to use, copy, modify, merge, publish, distribute, sublicense, + * and/or sell copies of the Software, and to permit persons to whom the + * Software is furnished to do so, subject to the following conditions: + * + * The above copyright notice and this permission notice shall be included in + * all copies or substantial portions of the Software. + * + * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR + * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE + * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER + * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING + * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER + * DEALINGS IN THE SOFTWARE. + */ + +package sys.net; + +import haxe.extern.Rest; +import sys.net.Socket; +import cs.NativeArray; +import cs.system.collections.ArrayList; +import cs.system.net.IPEndPoint; +import cs.system.net.EndPoint; +import cs.system.net.IPAddress; +import cs.system.net.sockets.AddressFamily; +import cs.system.net.sockets.NetworkStream; +import cs.system.net.sockets.ProtocolType; +import cs.system.net.sockets.SocketFlags; +import cs.system.net.sockets.SocketShutdown; +import cs.system.net.sockets.SocketType; +import cs.system.threading.Thread; +import cs.system.net.sockets.Socket in NativeSocket; +import cs.types.UInt8; +import cs.Ref; +import haxe.io.Bytes; +import haxe.io.Error; +import haxe.io.Input; +import haxe.io.Output; + +@:coreapi +class UdpSocket extends Socket { + public function new() { + super(); + } + + override private function init():Void { + sock = new NativeSocket(AddressFamily.InterNetwork, SocketType.Dgram, ProtocolType.Udp); + } + + override public function bind(host:Host, port:Int):Void { + sock = new NativeSocket(AddressFamily.InterNetwork, SocketType.Dgram, ProtocolType.Udp); + var endpoint:IPEndPoint = new IPEndPoint(host.ipAddress, port); + sock.Bind(endpoint); + } + + public function sendTo(buf:haxe.io.Bytes, pos:Int, len:Int, addr:Address):Int { + var data = new NativeArray(len); + var indices:NativeArray; + for (i in 0...len) { + indices = NativeArray.make(i); + data.SetValue(cast buf.get(pos + i), indices); + } + var host = addr.getHost(); + var ip:IPAddress = IPAddress.Parse(host.toString()); + var endpoint:IPEndPoint = new IPEndPoint(ip, addr.port); + return this.sock.SendTo(data, endpoint); + } + + public function readFrom(buf:haxe.io.Bytes, pos:Int, len:Int, addr:Address):Int { + var endpoint:EndPoint = cast new IPEndPoint(IPAddress.Any, 0); + var data:NativeArray = new NativeArray(len); + var length:Int = -1; + try { + length = this.sock.ReceiveFrom(data, endpoint); + } catch (e:Dynamic) { + return length; + } + var ipEndpoint:IPEndPoint = cast endpoint; + addr.host = ipEndpoint.Address.Address.high; + addr.port = ipEndpoint.Port; + var i:Int = 0; + for (each in data.iterator()) { + buf.set(pos + i, each); + i += 1; + } + return length; + } + + public function setBroadcast(b:Bool):Void { + sock.EnableBroadcast = b; + } +} diff --git a/std/cs/_std/sys/thread/Thread.hx b/std/cs/_std/sys/thread/Thread.hx index d2765a1a..ca2b2a2c 100644 --- a/std/cs/_std/sys/thread/Thread.hx +++ b/std/cs/_std/sys/thread/Thread.hx @@ -27,14 +27,38 @@ import cs.system.WeakReference; import cs.Lib; abstract Thread(HaxeThread) { + public var events(get,never):EventLoop; + inline function new(thread:HaxeThread) { this = thread; } - public static function create(cb:Void->Void):Thread { - var native = new NativeThread(cb); + public static function create(job:Void->Void):Thread { + var hx:Null = null; + var native = new NativeThread(job); + native.IsBackground = true; + hx = HaxeThread.allocate(native, false); + native.Start(); + + return new Thread(hx); + } + + public static inline function runWithEventLoop(job:()->Void):Void { + HaxeThread.runWithEventLoop(job); + } + + public static inline function createWithEventLoop(job:()->Void):Thread { + var hx:Null = null; + var native = new NativeThread(() -> { + job(); + if(hx == null) { + HaxeThread.get(NativeThread.CurrentThread).events.loop(); + } else { + hx.events.loop(); + } + }); native.IsBackground = true; - var hx = HaxeThread.allocate(native); + hx = HaxeThread.allocate(native, true); native.Start(); return new Thread(hx); @@ -55,30 +79,53 @@ abstract Thread(HaxeThread) { inline function readMessageImpl(block:Bool):Dynamic { return this.readMessage(block); } + + function get_events():EventLoop { + if(this.events == null) + throw new NoEventLoopException(); + return this.events; + } + + @:keep + static function initEventLoop():Void { + @:privateAccess HaxeThread.get(NativeThread.CurrentThread).events = new EventLoop(); + } + + @:keep + static function processEvents():Void { + HaxeThread.get(NativeThread.CurrentThread).events.loop(); + } } private class HaxeThread { + static final mainNativeThread = NativeThread.CurrentThread; + static final mainHaxeThread = new HaxeThread(NativeThread.CurrentThread); static final threads = new Map(); + static final threadsMutex = new cs.system.threading.Mutex(); static var allocateCount = 0; public final native:NativeThread; + public var events(default,null):Null; final messages = new Deque(); public static function get(native:NativeThread):HaxeThread { + if(native == mainNativeThread) { + return mainHaxeThread; + } var native = NativeThread.CurrentThread; - var ref:Null = null; - Lib.lock(threads, { - var key = native.ManagedThreadId; - ref = threads.get(key); - }); + var key = native.ManagedThreadId; + threadsMutex.WaitOne(); + var ref = threads.get(key); + threadsMutex.ReleaseMutex(); if (ref == null || !ref.IsAlive) { - return allocate(native); + return allocate(native, false); } return ref.Target; } - public static function allocate(native:NativeThread):HaxeThread { + public static function allocate(native:NativeThread, withEventLoop:Bool):HaxeThread { + threadsMutex.WaitOne(); allocateCount++; inline function cleanup() { if (allocateCount % 100 == 0) { @@ -90,15 +137,33 @@ private class HaxeThread { } } var hx = new HaxeThread(native); + if(withEventLoop) + hx.events = new EventLoop(); var ref = new WeakReference(hx); - Lib.lock(threads, { - cleanup(); - threads.set(native.ManagedThreadId, ref); - }); + cleanup(); + threads.set(native.ManagedThreadId, ref); + threadsMutex.ReleaseMutex(); return hx; } - public function new(native:NativeThread) { + public static function runWithEventLoop(job:()->Void):Void { + var thread = get(NativeThread.CurrentThread); + if(thread.events == null) { + thread.events = new EventLoop(); + try { + job(); + thread.events.loop(); + thread.events = null; + } catch(e) { + thread.events = null; + throw e; + } + } else { + job(); + } + } + + function new(native:NativeThread) { this.native = native; } diff --git a/std/cs/internal/HxObject.hx b/std/cs/internal/HxObject.hx index e1cca96e..dc6453f7 100644 --- a/std/cs/internal/HxObject.hx +++ b/std/cs/internal/HxObject.hx @@ -276,7 +276,7 @@ class HxEnum { } public function getTag():String { - return throw 'Not Implemented'; + return throw new haxe.exceptions.NotImplementedException(); } public function getParams():Array<{}> { diff --git a/std/eval/NativeString.hx b/std/eval/NativeString.hx new file mode 100644 index 00000000..27654f44 --- /dev/null +++ b/std/eval/NativeString.hx @@ -0,0 +1,45 @@ +package eval; + +import haxe.io.Bytes; + +@:coreType abstract NativeString { + /** String length */ + public var length(get,never):Int; + function get_length():Int; + + @:from static public function fromString(s:String):NativeString; + + @:from static public function fromBytes(b:Bytes):NativeString; + + /** + Returns a character at the specified `index`. + + Throws an exception if `index` is outside of the string bounds. + **/ + public function char(index:Int):String; + + /** + Returns a character code at the specified `index`. + + Throws an exception if `index` is outside of the string bounds. + **/ + public function code(index:Int):Int; + + /** + Returns a fresh string up to `length` characters long, containing the + substring that starts at position `start`. + + If `length` is not specified the all characters from `start` to the end + of this string are returned. + + Throws an exception if `index` is outside of the string bounds. + **/ + public function sub(start:Int, ?length:Int):NativeString; + + public function toString():String; + + public function toBytes():Bytes; + + @:op(A + B) + public function concat(s:NativeString):NativeString; +} \ No newline at end of file diff --git a/std/eval/_std/haxe/Exception.hx b/std/eval/_std/haxe/Exception.hx index da76a442..814370e7 100644 --- a/std/eval/_std/haxe/Exception.hx +++ b/std/eval/_std/haxe/Exception.hx @@ -15,7 +15,7 @@ class Exception { @:noCompletion var __previousException:Null; static function caught(value:Any):Exception { - if(Std.is(value, Exception)) { + if(Std.isOfType(value, Exception)) { return value; } else { return new ValueException(value, null, value); diff --git a/std/eval/_std/sys/ssl/Socket.hx b/std/eval/_std/sys/ssl/Socket.hx index 451cc6e5..96a3c7df 100644 --- a/std/eval/_std/sys/ssl/Socket.hx +++ b/std/eval/_std/sys/ssl/Socket.hx @@ -181,7 +181,7 @@ class Socket extends sys.net.Socket { } public function addSNICertificate(cbServernameMatch:String->Bool, cert:Certificate, key:Key):Void { - throw "Not implemented"; + throw new haxe.exceptions.NotImplementedException(); } public function peerCertificate():Certificate { @@ -189,7 +189,7 @@ class Socket extends sys.net.Socket { } public function setCertificate(cert:Certificate, key:Key):Void { - throw "Not implemented"; + throw new haxe.exceptions.NotImplementedException(); } private function buildConfig(server:Bool):Config { diff --git a/std/eval/_std/sys/thread/EventLoop.hx b/std/eval/_std/sys/thread/EventLoop.hx new file mode 100644 index 00000000..fad3699c --- /dev/null +++ b/std/eval/_std/sys/thread/EventLoop.hx @@ -0,0 +1,140 @@ +package sys.thread; + +import eval.luv.Loop; +import eval.luv.Async; +import eval.luv.Timer as LuvTimer; + +@:coreApi +enum NextEventTime { + Now; + Never; + AnyTime(time:Null); + At(time:Float); +} + +abstract EventHandler(RegularEvent) from RegularEvent to RegularEvent {} + +private class RegularEvent { + public var timer:Null; + public var event:()->Void; + + public function new(e:()->Void) { + event = e; + } + + public function run() { + event(); + } +} + +@:coreApi +class EventLoop { + @:allow(eval.luv.Loop) + final handle:Loop; + + final mutex = new Mutex(); + final oneTimeEvents = new ArrayVoid>>(); + var oneTimeEventsIdx = 0; + final wakeup:Async; + var promisedEventsCount = 0; + var pending:Array<()->Void> = []; + var looping = false; + + public function new():Void { + handle = Loop.init().resolve(); + wakeup = Async.init(handle, consumePending).resolve(); + wakeup.unref(); + } + + public function repeat(event:()->Void, intervalMs:Int):EventHandler { + var e = new RegularEvent(event); + mutex.acquire(); + pending.push(() -> { + e.timer = LuvTimer.init(handle).resolve(); + e.timer.start(e.run, intervalMs, intervalMs < 1 ? 1 : intervalMs).resolve(); + }); + mutex.release(); + wakeup.send(); + return e; + } + + public function cancel(eventHandler:EventHandler):Void { + mutex.acquire(); + (eventHandler:RegularEvent).event = noop; + pending.push(() -> { + var timer = (eventHandler:RegularEvent).timer; + timer.stop().resolve(); + timer.close(noop); + }); + mutex.release(); + wakeup.send(); + } + static final noop = function() {} + + public function promise():Void { + mutex.acquire(); + ++promisedEventsCount; + pending.push(refUnref); + mutex.release(); + wakeup.send(); + } + + public function run(event:()->Void):Void { + mutex.acquire(); + pending.push(event); + mutex.release(); + wakeup.send(); + } + + public function runPromised(event:()->Void):Void { + mutex.acquire(); + --promisedEventsCount; + pending.push(refUnref); + pending.push(event); + mutex.release(); + wakeup.send(); + } + + function refUnref():Void { + if(promisedEventsCount > 0) { + wakeup.ref(); + } else { + wakeup.unref(); + } + } + + public function progress():NextEventTime { + //TODO: throw if loop is already running + if((handle:Loop).run(NOWAIT)) { + return AnyTime(null); + } else { + return Never; + } + } + + public function wait(?timeout:Float):Bool { + //TODO: throw if loop is already running + if(timeout == null) { + var timer = LuvTimer.init(handle).resolve(); + timer.start(() -> { + timer.stop().resolve(); + timer.close(() -> {}); + }, Std.int(timeout * 1000)); + return (handle:Loop).run(ONCE); + } else { + return (handle:Loop).run(ONCE); + } + } + + public function loop():Void { + //TODO: throw if loop is already running + consumePending(); + (handle:Loop).run(DEFAULT); + } + + function consumePending(?_:Async):Void { + var p = pending; + pending = []; + for(fn in p) fn(); + } +} \ No newline at end of file diff --git a/std/eval/_std/sys/thread/Thread.hx b/std/eval/_std/sys/thread/Thread.hx index eb93020c..8d375bc8 100644 --- a/std/eval/_std/sys/thread/Thread.hx +++ b/std/eval/_std/sys/thread/Thread.hx @@ -25,6 +25,8 @@ package sys.thread; import eval.vm.NativeThread; abstract Thread(NativeThread) { + public var events(get,never):EventLoop; + inline function new(h:NativeThread):Void { this = h; } @@ -37,8 +39,34 @@ abstract Thread(NativeThread) { return new Thread(NativeThread.self()); } - public static inline function create(callb:Void->Void):Thread { - return new Thread(new NativeThread(callb)); + public static inline function create(job:()->Void):Thread { + return new Thread(new NativeThread(job)); + } + + public static function runWithEventLoop(job:()->Void):Void { + var thread = NativeThread.self(); + if(thread.events == null) { + thread.events = new EventLoop(); + try { + job(); + thread.events.loop(); + thread.events = null; + } catch(e) { + thread.events = null; + throw e; + } + } else { + job(); + } + } + + public static inline function createWithEventLoop(job:()->Void):Thread { + return new Thread(new NativeThread(() -> { + var thread = NativeThread.self(); + thread.events = new EventLoop(); + job(); + thread.events.loop(); + })); } public static inline function readMessage(block:Bool):Dynamic { @@ -54,7 +82,24 @@ abstract Thread(NativeThread) { return getHandle().id() == other.getHandle().id(); } - private inline function getHandle():NativeThread { + inline function getHandle():NativeThread { return this; } + + function get_events():EventLoop { + if(this.events == null) + throw new NoEventLoopException(); + return this.events; + } + + @:keep + static function initEventLoop() { + NativeThread.self().events = new EventLoop(); + } + + + @:keep + static function processEvents():Void { + NativeThread.self().events.loop(); + } } diff --git a/std/eval/integers/Int64.hx b/std/eval/integers/Int64.hx new file mode 100644 index 00000000..27ac0c68 --- /dev/null +++ b/std/eval/integers/Int64.hx @@ -0,0 +1,116 @@ +package eval.integers; + +/** + Signed 64-bit integer type and operations. +**/ +@:coreType abstract Int64 { + /** The greatest representable Int64 value. */ + extern static public final MAX:Int64; + /** The smallest representable Int64 value. */ + extern static public final MIN:Int64; + /** The integer `0` */ + extern static public final ZERO:Int64; + /** The integer `1` */ + extern static public final ONE:Int64; + + /** + Convert the given int value to Int64. + **/ + static public function ofInt(i:Int):Int64; + + /** + Parse the given string value to Int64. + Throws if the given string is not a valid representation of Int64. + **/ + static public function ofString(s:String):Int64; + + /** + Convert `haxe.Int64` to `eval.integers.Int64` + **/ + @:from static public function ofHxInt64(hx:haxe.Int64):Int64; + + /** + Returns the greater of `a` and `b`. + **/ + static public function max(a:Int64, b:Int64):Int64; + + /** + Returns the lesser of `a` and `b`. + **/ + static public function min(a:Int64, b:Int64):Int64; + + /** + Compare given values. + Returns `0` if the values are equal. + Returns negative integer if `a` is lesser than `b`. + Returns positive integer if `a` is greater than `b`. + **/ + static public function compare(a:Int64, b:Int64):Int; + + /** + Convert to an integer value. + The 64-bit signed integer is taken modulo 2{^32}, i.e. the top 32 bits + are lost during the conversion. + **/ + public function toInt():Int; + + /** + Convert to an unsigned integer value. + **/ + public function toUInt64():UInt64; + + /** + Convert to `haxe.Int64`. + **/ + @:to public function toHxInt64():haxe.Int64; + + /** + Return the string representation of this value. + **/ + public function toString():String; + + /** + Successor. + **/ + public function successor():String; + + /** + Predecessor. + **/ + public function predecessor():String; + + /** + Integer remainder. + Throws if the divisor is zero. + **/ + public function remainder(u:Int64):Int64; + + function add(u:Int64):Int64; + function sub(u:Int64):Int64; + function mul(u:Int64):Int64; + function div(u:Int64):Int64; + function logand(u:Int64):Int64; + function logor(u:Int64):Int64; + function logxor(u:Int64):Int64; + function shift_left(i:Int):Int64; + function shift_right(i:Int):Int64; + function lognot():Int64; + + @:op(A + B) inline function _add(u:Int64):Int64 return this.add(u); + @:op(A - B) inline function _sub(u:Int64):Int64 return this.sub(u); + @:op(A * B) inline function _mul(u:Int64):Int64 return this.mul(u); + @:op(A / B) inline function _div(u:Int64):Int64 return this.div(u); + @:op(A & B) inline function _logand(u:Int64):Int64 return this.logand(u); + @:op(A | B) inline function _logor(u:Int64):Int64 return this.logor(u); + @:op(A ^ B) inline function _logxor(u:Int64):Int64 return this.logxor(u); + @:op(A << B) inline function _shift_left(i:Int):Int64 return this.shift_left(i); + @:op(A >> B) inline function _shift_right(i:Int):Int64 return this.shift_right(i); + @:op(~A) inline function _lognot():Int64 return this.lognot(); + + @:op(A != B) static inline function eq(a:Int64, b:Int64):Bool return compare(a, b) != 0; + @:op(A == B) static inline function ne(a:Int64, b:Int64):Bool return compare(a, b) == 0; + @:op(A < B) static inline function lt(a:Int64, b:Int64):Bool return compare(a, b) < 0; + @:op(A > B) static inline function gt(a:Int64, b:Int64):Bool return compare(a, b) > 0; + @:op(A <= B) static inline function lte(a:Int64, b:Int64):Bool return compare(a, b) <= 0; + @:op(A >= B) static inline function gte(a:Int64, b:Int64):Bool return compare(a, b) >= 0; +} \ No newline at end of file diff --git a/std/eval/integers/UInt64.hx b/std/eval/integers/UInt64.hx new file mode 100644 index 00000000..ba8b5640 --- /dev/null +++ b/std/eval/integers/UInt64.hx @@ -0,0 +1,109 @@ +package eval.integers; + +/** + Unsigned 64-bit integer type and operations. +**/ +@:coreType abstract UInt64 { + /** The greatest representable UInt64 value. */ + extern static public final MAX:UInt64; + /** The integer `0` */ + extern static public final ZERO:UInt64; + /** The integer `1` */ + extern static public final ONE:UInt64; + + /** + Convert the given int value to an unsigned integer. + **/ + static public function ofInt(i:Int):UInt64; + + /** + Parse the given string value to an unsigned integer. +<<<<<<< HEAD + +======= +>>>>>>> development + Throws if the given string is not a valid representation of an unsigned + integer. + **/ + static public function ofString(s:String):UInt64; + + /** + Returns the greater of `a` and `b`. + **/ + static public function max(a:UInt64, b:UInt64):UInt64; + + /** + Returns the lesser of `a` and `b`. + **/ + static public function min(a:UInt64, b:UInt64):UInt64; + + /** + Compare given values. + Returns `0` if the values are equal. + Returns negative integer if `a` is lesser than `b`. + Returns positive integer if `a` is greater than `b`. + **/ + static public function compare(a:UInt64, b:UInt64):Int; + + /** + Convert to an integer value. + The 64-bit unsigned integer is taken modulo 2{^32}, i.e. the top 32 bits + are lost during the conversion. + **/ + public function toInt():Int; + + /** + Convert to a signed integer value. + **/ + public function toInt64():Int64; + + /** + Return the string representation of this value. + **/ + public function toString():String; + + /** + Successor. + **/ + public function successor():String; + + /** + Predecessor. + **/ + public function predecessor():String; + + /** + Integer remainder. + Throws if the divisor is zero. + **/ + public function remainder(u:UInt64):UInt64; + + function add(u:UInt64):UInt64; + function sub(u:UInt64):UInt64; + function mul(u:UInt64):UInt64; + function div(u:UInt64):UInt64; + function logand(u:UInt64):UInt64; + function logor(u:UInt64):UInt64; + function logxor(u:UInt64):UInt64; + function shift_left(i:Int):UInt64; + function shift_right(i:Int):UInt64; + function lognot():UInt64; + + @:op(A + B) inline function _add(u:UInt64):UInt64 return this.add(u); + @:op(A - B) inline function _sub(u:UInt64):UInt64 return this.sub(u); + @:op(A * B) inline function _mul(u:UInt64):UInt64 return this.mul(u); + @:op(A / B) inline function _div(u:UInt64):UInt64 return this.div(u); + @:op(A & B) inline function _logand(u:UInt64):UInt64 return this.logand(u); + @:op(A | B) inline function _logor(u:UInt64):UInt64 return this.logor(u); + @:op(A ^ B) inline function _logxor(u:UInt64):UInt64 return this.logxor(u); + @:op(A << B) inline function _shift_left(i:Int):UInt64 return this.shift_left(i); + @:op(A >> B) inline function _shift_right(i:Int):UInt64 return this.shift_right(i); + @:op(~A) inline function _lognot():UInt64 return this.lognot(); + + @:op(A != B) static inline function eq(a:UInt64, b:UInt64):Bool return compare(a, b) != 0; + @:op(A == B) static inline function ne(a:UInt64, b:UInt64):Bool return compare(a, b) == 0; + @:op(A < B) static inline function lt(a:UInt64, b:UInt64):Bool return compare(a, b) < 0; + @:op(A > B) static inline function gt(a:UInt64, b:UInt64):Bool return compare(a, b) > 0; + @:op(A <= B) static inline function lte(a:UInt64, b:UInt64):Bool return compare(a, b) <= 0; + @:op(A >= B) static inline function gte(a:UInt64, b:UInt64):Bool return compare(a, b) >= 0; +} \ No newline at end of file diff --git a/std/eval/luv/Async.hx b/std/eval/luv/Async.hx new file mode 100644 index 00000000..441a0851 --- /dev/null +++ b/std/eval/luv/Async.hx @@ -0,0 +1,21 @@ +package eval.luv; + +/** + Inter-loop communication. + + @see https://aantron.github.io/luv/luv/Luv/Async +**/ +@:using(eval.luv.Handle) +@:coreType abstract Async to Handle { + /** + Allocates and initializes an async handle. + + The handle should be cleaned up with `eval.luv.Handle.close` when no longer needed. + **/ + static public function init(loop:Loop, callback:(async:Async)->Void):Result; + + /** + Triggers a call to the handle's callback by the handle's loop. + **/ + public function send():Result; +} \ No newline at end of file diff --git a/std/eval/luv/Barrier.hx b/std/eval/luv/Barrier.hx new file mode 100644 index 00000000..14756955 --- /dev/null +++ b/std/eval/luv/Barrier.hx @@ -0,0 +1,23 @@ +package eval.luv; + +/** + Barriers. + + @see https://aantron.github.io/luv/luv/Luv/Barrier +**/ +@:coreType abstract Barrier { + /** + Allocates and initializes a barrier. + **/ + static public function init(count:Int):Result; + + /** + Cleans up a barrier. + **/ + public function destroy():Void; + + /** + Waits on a barrier. + **/ + public function wait():Bool; +} \ No newline at end of file diff --git a/std/eval/luv/Buffer.hx b/std/eval/luv/Buffer.hx new file mode 100644 index 00000000..a7a7fdfe --- /dev/null +++ b/std/eval/luv/Buffer.hx @@ -0,0 +1,120 @@ +package eval.luv; + +import haxe.io.Bytes; + +/** + Data buffers. + + @see https://aantron.github.io/luv/luv/Luv/Buffer +**/ +@:coreType abstract Buffer { + /** + Allocates a fresh buffer of the given size. + **/ + static public function create(size:Int):Buffer; + + /** + Creates a buffer from a string. + **/ + @:from static public function fromNativeString(s:NativeString):Buffer; + + /** + Creates a buffer from a string. + **/ + @:from static public function fromString(s:String):Buffer; + + /** + Creates a buffer from bytes. + **/ + @:from static public function fromBytes(b:Bytes):Buffer; + + /** + Evaluates to the sum of the sizes of the buffers in the array. + **/ + static public function totalSize(buffers:Array):Int; + + /** + `Buffer.drop(buffers, count)` drops the first `count` bytes from `buffers`. + + For example, if `buffers` contains two buffers of size 16, `Buffer.drop(buffers, 18)` + will evaluate to an array that has lost the reference to the first buffer, + and contains only a view into the second buffer of size 14. + **/ + static public function drop(buffers:Array, count:Int):Array; + + /** + Evaluates to the size of the buffer. + **/ + public function size():Int; + + /** + Retrieve a byte at the given index. + **/ + @:arrayAccess public function get(index:Int):Int; + + /** + Retrieve a byte at the given index without a bounds check. + **/ + public function unsafeGet(index:Int):Int; + + /** + Set byte value at the given index. + **/ + @:arrayAccess public function set(index:Int, byte:Int):Int; + + /** + Set byte value at the given index without a bounds check. + **/ + public function unsafeSet(index:Int, byte:Int):Int; + + /** + Creates a view into buffer that starts at the given `offset` and has the given `length`. + + No data is copied. + **/ + public function sub(offset:Int, length:Int):Buffer; + + /** + Copies data from this buffer to destination. + + The amount of data copied is the minimum of the two buffers' size. + **/ + public function blit(destination:Buffer):Void; + + /** + Fills the given buffer with the given byte. + **/ + public function fill(byte:Int):Void; + + /** + Creates a string with the same contents as the buffer. + **/ + public function toString():String; + + /** + Creates a native string with the same contents as the buffer. + **/ + public function toNativeString():NativeString; + + /** + Creates a `haxe.io.Bytes` instance with the same contents as this buffer. + **/ + public function toBytes():Bytes; + + /** + Copies data from a buffer to bytes buffer. + **/ + public function blitToBytes(destination:Bytes, destinationOffset:Int):Void; + + /** + Copies data from bytes to a buffer. + **/ + public function blitFromBytes(source:Bytes, sourceOffset:Int):Void; + + /** + Copies data from bytes to a buffer. + + Note: `sourceOffset` is not a character offset but a byte offset. + **/ + public function blitFromString(source:NativeString, sourceOffset:Int):Void; +} \ No newline at end of file diff --git a/std/eval/luv/Check.hx b/std/eval/luv/Check.hx new file mode 100644 index 00000000..b3bd647c --- /dev/null +++ b/std/eval/luv/Check.hx @@ -0,0 +1,26 @@ +package eval.luv; + +/** + Post-I/O callback. + + @see https://aantron.github.io/luv/luv/Luv/Check +**/ +@:using(eval.luv.Handle) +@:coreType abstract Check to Handle { + /** + Allocate and initialize a check handle. + + The handle should be cleaned up with `eval.luv.Handle.close` when no longer needed. + **/ + static public function init(loop:Loop):Result; + + /** + Starts the handle with the given callback. + **/ + public function start(callback:()->Void):Result; + + /** + Stops the handle. + **/ + public function stop():Result; +} \ No newline at end of file diff --git a/std/eval/luv/Condition.hx b/std/eval/luv/Condition.hx new file mode 100644 index 00000000..8ce3aea2 --- /dev/null +++ b/std/eval/luv/Condition.hx @@ -0,0 +1,39 @@ +package eval.luv; + +/** + Condition variables. + + @see https://aantron.github.io/luv/luv/Luv/Condition +**/ +@:coreType abstract Condition { + /** + Allocates and initializes a condition variable. + **/ + static public function init():Result; + + /** + Cleans up a condition variable. + **/ + public function destroy():Void; + + /** + Signals a condition variable. + **/ + public function signal():Void; + + /** + Signals a condition variable, waking all waiters. + **/ + public function broadcast():Void; + + /** + Waits on a condition variable. + **/ + public function wait(mutex:Mutex):Void; + + /** + Waits on a condition variable with a timeout. + The timeout is given in nanoseconds. + **/ + public function timedWait(mutex:Mutex, timeout:Int):Void; +} \ No newline at end of file diff --git a/std/eval/luv/ConnectedUdp.hx b/std/eval/luv/ConnectedUdp.hx new file mode 100644 index 00000000..5df83a09 --- /dev/null +++ b/std/eval/luv/ConnectedUdp.hx @@ -0,0 +1,34 @@ +package eval.luv; + +import eval.luv.SockAddr; + +/** + Connected UDP sockets. + + @see https://aantron.github.io/luv/luv/Luv/UDP/Connected +**/ +@:forward +@:using(eval.luv.Handle) +abstract ConnectedUdp(Udp) to Udp to Handle { + /** + Removes the peer address assigned to the given socket. + **/ + extern public function disconnect():Result; + + /** + Retrieves the peer address assigned to the given socket. + **/ + extern public function getPeerName():Result; + + /** + Like `eval.luv.UDP.send`, but the remote address used is the peer address + assigned to the socket. + **/ + extern public function send(data:Array, callback:(result:Result)->Void):Void; + + /** + Like `eval.luv.UDP.trySend`, but the remote address used is the peer address + assigned to the socket. + **/ + extern public function trySend(data:Array):Result; +} \ No newline at end of file diff --git a/std/eval/luv/Dir.hx b/std/eval/luv/Dir.hx new file mode 100644 index 00000000..11a5abd5 --- /dev/null +++ b/std/eval/luv/Dir.hx @@ -0,0 +1,73 @@ +package eval.luv; + +import eval.luv.File; + +enum abstract DirentKind(Int) { + var UNKNOWN = 0; + var FILE = 1; + var DIR = 2; + var LINK = 3; + var FIFO = 4; + var SOCKET = 5; + var CHAR = 6; + var BLOCK = 7; +} + +typedef Dirent = { + var kind:DirentKind; + var name:NativeString; +} + +typedef DirectoryScan = { + /** + Retrieves the next directory entry. + **/ + function next():Null; + + /** + Cleans up after a directory scan. + **/ + function end():Void; +} + +/** + @see https://aantron.github.io/luv/luv/Luv/File#module-Dir +**/ +@:coreType abstract Dir { + /** + Opens the directory at the given path for listing. + **/ + static public function open(loop:Loop, path:NativeString, ?request:FileRequest, callback:(result:Result)->Void):Void; + + /** + Closes the directory. + **/ + public function close(loop:Loop, ?request:FileRequest, callback:(result:Result)->Void):Void; + + /** + Retrieves a directory entry. + **/ + public function read(loop:Loop, ?numberOfEntries:Int, ?request:FileRequest, callback:(result:Result>)->Void):Void; + + /** + Begins directory listing. + **/ + static public function scan(loop:Loop, path:NativeString, ?request:FileRequest, callback:(result:Result)->Void):Void; +} + +/** + Synchronous version of `eval.luv.Dir` API +**/ +extern class DirSync { + @:inheritDoc(eval.luv.Dir.open) + static public function open(loop:Loop, path:NativeString):Result; + + @:inheritDoc(eval.luv.Dir.close) + static public function close(dir:Dir, loop:Loop):Result; + + @:inheritDoc(eval.luv.Dir.read) + static public function read(dir:Dir, loop:Loop, ?numberOfEntries:Int):Result>; + + @:inheritDoc(eval.luv.Dir.scan) + static public function scan(loop:Loop, path:NativeString):Result; +} \ No newline at end of file diff --git a/std/eval/luv/Dns.hx b/std/eval/luv/Dns.hx new file mode 100644 index 00000000..bb609740 --- /dev/null +++ b/std/eval/luv/Dns.hx @@ -0,0 +1,69 @@ +package eval.luv; + +@:forward +abstract AddrInfoRequest(Request) to Request {} + +typedef AddrInfo = { + var family:SockAddr.AddressFamily; + var sockType:SockAddr.SocketType; + var protocol:Int; + var addr:SockAddr; + var ?canonName:String; +} + +typedef AddrInfoOptions = { + var ?request:AddrInfoRequest; + var ?family:SockAddr.AddressFamily; + var ?sockType:SockAddr.SocketType; + var ?protocol:Int; + var ?flags:Array; +} + +enum abstract AddrInfoFlag(Int) { + var PASSIVE = 0; + var CANONNAME = 1; + var NUMERICHOST = 2; + var NUMERICSERV = 3; + var V4MAPPED = 4; + var ALL = 5; + var ADDRCONFIG = 6; +} + +@:forward +abstract NameInfoRequest(Request) to Request {} + +enum abstract NameInfoFlag(Int) { + var NAMEREQD = 0; + var DGRAM = 1; + var NOFQDN = 2; + var NUMERICHOST = 3; + var NUMERICSERV = 4; +} + +typedef NameInfoOptions = { + var ?request:NameInfoRequest; + var ?flags:Array; +} + +/** + DNS queries. + + @see https://aantron.github.io/luv/luv/Luv/Dns +**/ +extern class Dns { + + static function createAddrRequest():AddrInfoRequest; + + static function createNameRequest():NameInfoRequest; + + /** + Retrieves addresses. + Either `node` or `service` may be `null` but not both. + **/ + static function getAddrInfo(loop:Loop, node:Null, service:Null, ?options:AddrInfoOptions, callback:(result:Result>)->Void):Void; + + /** + Retrieves host names. + **/ + static function getNameInfo(loop:Loop, addr:SockAddr, ?options:NameInfoOptions, callback:(result:Result<{hostName:String, service:String}>)->Void):Void; +} \ No newline at end of file diff --git a/std/eval/luv/Env.hx b/std/eval/luv/Env.hx new file mode 100644 index 00000000..5e86261a --- /dev/null +++ b/std/eval/luv/Env.hx @@ -0,0 +1,23 @@ +package eval.luv; + +/** + Environment variables. + + @see https://aantron.github.io/luv/luv/Luv/Env +**/ +extern class Env { + /** + Retrieves the value of an environment variable. + **/ + static function getEnv(name:String):Result; + + /** + Sets an environment variable. + **/ + static function setEnv(name:String, value:NativeString):Result; + + /** + Retrieves all environment variables. + **/ + static function environ():Result>; +} \ No newline at end of file diff --git a/std/eval/luv/File.hx b/std/eval/luv/File.hx new file mode 100644 index 00000000..d6233432 --- /dev/null +++ b/std/eval/luv/File.hx @@ -0,0 +1,424 @@ +package eval.luv; + +import eval.integers.Int64; +import eval.integers.UInt64; + +@:forward +abstract FileRequest(Request) to Request {} + +enum abstract FileOpenFlag(Int) { + var RDONLY = 0; + var WRONLY = 1; + var RDWR = 2; + var CREAT = 3; + var EXCL = 4; + var EXLOCK = 5; + var NOCTTY = 6; + var NOFOLLOW = 7; + var TEMPORARY = 8; + var TRUNC = 9; + var APPEND = 10; + var DIRECT = 11; + var DSYNC = 12; + var FILEMAP = 13; + var NOATIME = 14; + var NONBLOCK = 15; + var RANDOM = 16; + var SEQUENTIAL = 17; + var SHORT_LIVED = 18; + var SYMLINK = 19; + var SYNC = 20; +} + +/** + Permission bits. + @see https://aantron.github.io/luv/luv/Luv/File/Mode +**/ +enum FileMode { + IRWXU; + IRUSR; + IWUSR; + IXUSR; + IRWXG; + IRGRP; + IWGRP; + IXGRP; + IRWXO; + IROTH; + IWOTH; + IXOTH; + ISUID; + ISGID; + ISVTX; + IFMT; + IFREG; + IFDIR; + IFBLK; + IFCHR; + IFLNK; + IFIFO; + NUMERIC(mode:Int); +} + +/** + Abstract type for a bit field of permissions bits, i.e., an `int` in which + multiple bits may be set. These bit fields are returned by operations such + as `eval.luv.File.stat` +**/ +@:coreType abstract FileModeNumeric {} + +typedef FileStatTimeSpec = { + var sec:Int64; + var nsec:Int64; +} + +typedef FileStat = { + var dev:UInt64; + var mode:FileModeNumeric; + var nlink:UInt64; + var uid:UInt64; + var gid:UInt64; + var rdev:UInt64; + var ino:UInt64; + var size:UInt64; + var blksize:UInt64; + var blocks:UInt64; + var flags:UInt64; + var gen:UInt64; + var atim:FileStatTimeSpec; + var mtim:FileStatTimeSpec; + var ctim:FileStatTimeSpec; + var birthtim:FileStatTimeSpec; +} + +typedef FileStatFs = { + var type:UInt64; + var bsize:UInt64; + var blocks:UInt64; + var bfree:UInt64; + var bavail:UInt64; + var files:UInt64; + var ffree:UInt64; + var fspare:Array; +} + +enum abstract FileCopyFlag(Int) { + var COPYFILE_EXCL = 0; + var COPYFILE_FICLONE = 1; + var COPYFILE_FICLONE_FORCE = 2; +} + +enum abstract FileAccessFlag(Int) { + var F_OK = 0; + var R_OK = 1; + var W_OK = 2; + var X_OK = 3; +} + +enum abstract FileSymlinkFlag(Int) { + var SYMLINK_DIR = 0; + var SYMLINK_JUNCTION = 1; +} + +/** + Files. + + @see https://aantron.github.io/luv/luv/Luv/File +**/ +@:using(eval.luv.Handle) +@:coreType abstract File to Handle { + + extern static public final stdin:File; + extern static public final stdout:File; + extern static public final stderr:File; + + static public function createRequest():FileRequest; + + /** + Checks whether all the bits in `mask` are set in `bits`. + + For example, if `bits` is equal to octal 0o644, then + `eval.luv.File.testMode [IRUSR] bits` evaluates to `true`. + **/ + static public function testMode(mask:Array, bits:FileModeNumeric):Bool; + + /** + Opens the file at the given path. + The default value of the `mode` argument is equal to octal `0o644`. + **/ + static public function open(loop:Loop, path:NativeString, flags:Array, ?mode:Array, ?request:FileRequest, callback:(result:Result)->Void):Void; + + /** + Closes the file. + **/ + public function close(loop:Loop, ?request:FileRequest, callback:(result:Result)->Void):Void; + + /** + Reads from the file. + + The incoming data is written consecutively to into the given buffers. + The number of bytes that the operation tries to read is the total length + of the buffers. + + End of file is indicated by `Result.Ok(0)`. Note that this is different + from `eval.luv.Stream.readStart`. + **/ + public function read(loop:Loop, fileOffset:Int64, buffers:Array, ?request:FileRequest, callback:(result:Result)->Void):Void; + + /** + Writes to the file. + **/ + public function write(loop:Loop, fileOffset:Int64, buffers:Array, ?request:FileRequest, callback:(result:Result)->Void):Void; + + /** + Deletes the file at the given path. + **/ + static public function unlink(loop:Loop, path:NativeString, ?request:FileRequest, callback:(result:Result)->Void):Void; + + /** + Moves the file at the given path to the path given by `toPath` + **/ + static public function rename(loop:Loop, path:NativeString, toPath:NativeString, ?request:FileRequest, callback:(result:Result)->Void):Void; + + /** + Creates a temporary file with name based on the given pattern. + **/ + static public function mkstemp(loop:Loop, pattern:NativeString, ?request:FileRequest, callback:(result:Result<{name:NativeString,file:File}>)->Void):Void; + + /** + Creates a temporary directory with name based on the given pattern. + **/ + static public function mkdtemp(loop:Loop, pattern:NativeString, ?request:FileRequest, callback:(result:Result)->Void):Void; + + /** + Creates a directory. + **/ + static public function mkdir(loop:Loop, path:NativeString, ?mode:Array, ?request:FileRequest, callback:(result:Result)->Void):Void; + + /** + Deletes a directory. + **/ + static public function rmdir(loop:Loop, path:NativeString, ?request:FileRequest, callback:(result:Result)->Void):Void; + + /** + Retrieves status information for the file at the given path. + **/ + static public function stat(loop:Loop, path:NativeString, ?request:FileRequest, callback:(result:Result)->Void):Void; + + /** + Like `eval.luv.File.stat`, but does not dereference symlinks. + **/ + static public function lstat(loop:Loop, path:NativeString, ?request:FileRequest, callback:(result:Result)->Void):Void; + + /** + Retrieves status information for this file. + **/ + public function fstat(loop:Loop, ?request:FileRequest, callback:(result:Result)->Void):Void; + + /** + Retrieves status information for the filesystem containing the given path. + **/ + static public function statFs(loop:Loop, path:NativeString, ?request:FileRequest, callback:(result:Result)->Void):Void; + + /** + Flushes file changes to storage. + **/ + public function fsync(loop:Loop, ?request:FileRequest, callback:(result:Result)->Void):Void; + + /** + Like `eval.luv.File.fsync`, but may omit some metadata. + **/ + public function fdataSync(loop:Loop, ?request:FileRequest, callback:(result:Result)->Void):Void; + + /** + Truncates the given file to the given length. + **/ + public function ftruncate(loop:Loop, length:Int64, ?request:FileRequest, callback:(result:Result)->Void):Void; + + /** + Copies the file at the given path to the path given by `toPath`. + **/ + static public function copyFile(loop:Loop, path:NativeString, toPath:NativeString, ?flags:Array, ?request:FileRequest, callback:(result:Result)->Void):Void; + + /** + Transfers data between file descriptors. + **/ + public function sendFile(loop:Loop, toFile:File, offset:Int64, length:UInt64, ?request:FileRequest, callback:(result:Result)->Void):Void; + + /** + Checks whether the calling process can access the file at the given path. + **/ + static public function access(loop:Loop, path:NativeString, flags:Array, ?request:FileRequest, callback:(result:Result)->Void):Void; + + /** + Changes permissions of the file at the given path. + **/ + static public function chmod(loop:Loop, path:NativeString, mode:Array, ?request:FileRequest, callback:(result:Result)->Void):Void; + + /** + Changes permissions of the file. + **/ + public function fchmod(loop:Loop, mode:Array, ?request:FileRequest, callback:(result:Result)->Void):Void; + + /** + Sets timestamps of the file at the given path. + **/ + static public function utime(loop:Loop, path:NativeString, atime:Float, mtime:Float, ?request:FileRequest, callback:(result:Result)->Void):Void; + + /** + Sets timestamps of the file. + **/ + public function futime(loop:Loop, atime:Float, mtime:Float, ?request:FileRequest, callback:(result:Result)->Void):Void; + + /** + Sets timestamps of the file at the given path without dereferencing symlinks. + **/ + static public function lutime(loop:Loop, path:NativeString, atime:Float, mtime:Float, ?request:FileRequest, callback:(result:Result)->Void):Void; + + /** + Hardlinks a file at the location given by `link`. + **/ + static public function link(loop:Loop, path:NativeString, link:NativeString, ?request:FileRequest, callback:(result:Result)->Void):Void; + + /** + Symlinks a file at the location given by `link`. + **/ + static public function symlink(loop:Loop, path:NativeString, link:NativeString, ?flags:Array, ?request:FileRequest, callback:(result:Result)->Void):Void; + + /** + Reads the target path of a symlink. + **/ + static public function readLink(loop:Loop, path:NativeString, ?request:FileRequest, callback:(result:Result)->Void):Void; + + /** + Resolves a real absolute path to the given file. + **/ + static public function realPath(loop:Loop, path:NativeString, ?request:FileRequest, callback:(result:Result)->Void):Void; + + /** + Changes owneship of the file at the given path. + **/ + static public function chown(loop:Loop, path:NativeString, uid:Int, gid:Int, ?request:FileRequest, callback:(result:Result)->Void):Void; + + /** + Changes owneship of the file at the given path. without dereferencing symlinks. + **/ + static public function lchown(loop:Loop, path:NativeString, uid:Int, gid:Int, ?request:FileRequest, callback:(result:Result)->Void):Void; + + /** + Changes owneship of the file. + **/ + public function fchown(loop:Loop, uid:Int, gid:Int, ?request:FileRequest, callback:(result:Result)->Void):Void; + + /** + Returns the integer representation of `eval.luv.File`. + + `eval.luv.File` is defined as an integer file descriptor by libuv on all + platforms at the moment. This is a convenience function for interoperability + with `eval.luv.Process`, the API of which assumes that files are represented + by integers. + **/ + public function toInt():Int; +} + +/** + Synchronous version of `eval.luv.File` API +**/ +extern class FileSync { + @:inheritDoc(eval.luv.File.open) + static function open(path:NativeString, flags:Array, ?mode:Array):Result; + + @:inheritDoc(eval.luv.File.close) + static function close(file:File):Result; + + @:inheritDoc(eval.luv.File.read) + static function read(file:File, fileOffset:Int64, buffers:Array):Result; + + @:inheritDoc(eval.luv.File.write) + static function write(file:File, fileOffset:Int64, buffers:Array):Result; + + @:inheritDoc(eval.luv.File.unlink) + static function unlink(path:NativeString):Result; + + @:inheritDoc(eval.luv.File.rename) + static function rename(path:NativeString, toPath:NativeString):Result; + + @:inheritDoc(eval.luv.File.mkstemp) + static function mkstemp(pattern:NativeString):Result<{name:NativeString,file:File}>; + + @:inheritDoc(eval.luv.File.mkdtemp) + static function mkdtemp(pattern:NativeString):Result; + + @:inheritDoc(eval.luv.File.mkdir) + static function mkdir(path:NativeString, ?mode:Array):Result; + + @:inheritDoc(eval.luv.File.rmdir) + static function rmdir(path:NativeString):Result; + + @:inheritDoc(eval.luv.File.stat) + static function stat(path:NativeString):Result; + + @:inheritDoc(eval.luv.File.lstat) + static function lstat(path:NativeString):Result; + + @:inheritDoc(eval.luv.File.fstat) + static function fstat(file:File):Result; + + @:inheritDoc(eval.luv.File.statFs) + static function statFs(path:NativeString):Result; + + @:inheritDoc(eval.luv.File.fsync) + static function fsync(file:File):Result; + + @:inheritDoc(eval.luv.File.fdataSync) + static function fdataSync(file:File):Result; + + @:inheritDoc(eval.luv.File.ftruncate) + static function ftruncate(file:File, length:Int64):Result; + + @:inheritDoc(eval.luv.File.copyFile) + static function copyFile(path:NativeString, toPath:NativeString, ?flags:Array):Result; + + @:inheritDoc(eval.luv.File.sendFile) + static function sendFile(file:File, toFile:File, offset:Int64, length:UInt64):Result; + + @:inheritDoc(eval.luv.File.access) + static function access(path:NativeString, flags:Array):Result; + + @:inheritDoc(eval.luv.File.chmod) + static function chmod(path:NativeString, mode:Array):Result; + + @:inheritDoc(eval.luv.File.fchmod) + static function fchmod(file:File, mode:Array):Result; + + @:inheritDoc(eval.luv.File.utime) + static function utime(path:NativeString, atime:Float, mtime:Float):Result; + + @:inheritDoc(eval.luv.File.futime) + static function futime(file:File, atime:Float, mtime:Float):Result; + + @:inheritDoc(eval.luv.File.lutime) + static function lutime(path:NativeString, atime:Float, mtime:Float):Result; + + @:inheritDoc(eval.luv.File.link) + static function link(path:NativeString, link:NativeString):Result; + + @:inheritDoc(eval.luv.File.symlink) + static function symlink(path:NativeString, link:NativeString, ?flags:Array):Result; + + @:inheritDoc(eval.luv.File.readLink) + static function readLink(path:NativeString):Result; + + @:inheritDoc(eval.luv.File.realPath) + static function realPath(path:NativeString):Result; + + @:inheritDoc(eval.luv.File.chown) + static function chown(path:NativeString, uid:Int, gid:Int):Result; + + @:inheritDoc(eval.luv.File.lchown) + static function lchown(path:NativeString, uid:Int, gid:Int):Result; + + @:inheritDoc(eval.luv.File.fchown) + static function fchown(file:File, uid:Int, gid:Int):Result; + +} \ No newline at end of file diff --git a/std/eval/luv/FsEvent.hx b/std/eval/luv/FsEvent.hx new file mode 100644 index 00000000..55711381 --- /dev/null +++ b/std/eval/luv/FsEvent.hx @@ -0,0 +1,36 @@ +package eval.luv; + +enum abstract FsEventType(Int) { + var RENAME = 0; + var CHANGE = 1; +} + +enum abstract FsEventFlag(Int) { + var FS_EVENT_WATCH_ENTRY = 0; + var FS_EVENT_STAT = 1; + var FS_EVENT_RECURSIVE = 2; +} + +/** + Filesystem events. + + @see https://aantron.github.io/luv/luv/Luv/FS_event +**/ +@:using(eval.luv.Handle) +@:coreType abstract FsEvent to Handle { + /** + Allocates and initializes an FS event handle. + **/ + static public function init(loop:Loop):Result; + + /** + Starts the handle and watches the given path for changes. + **/ + public function start(path:NativeString, ?flags:Array, callback:(result:Result<{file:NativeString,events:Array}>)->Void):Void; + + /** + Stops the handle. + **/ + public function stop():Result; + +} \ No newline at end of file diff --git a/std/eval/luv/FsPoll.hx b/std/eval/luv/FsPoll.hx new file mode 100644 index 00000000..3587d846 --- /dev/null +++ b/std/eval/luv/FsPoll.hx @@ -0,0 +1,30 @@ +package eval.luv; + +import eval.luv.File; + +/** + Filesystem polling. + + @see https://aantron.github.io/luv/luv/Luv/FS_poll +**/ +@:using(eval.luv.Handle) +@:coreType abstract FsPoll to Handle { + /** + Allocates and initializes an FS polling handle. + + The handle should be cleaned up with `eval.luv.Handle.close` when no longer needed. + **/ + static public function init(loop:Loop):Result; + + /** + Starts the handle and polls the given path for changes. + + The default value of `interval` is 2000 (milliseconds). + **/ + public function start(path:NativeString, ?interval:Int, callback:(result:Result<{previous:FileStat,current:FileStat}>)->Void):Void; + + /** + Stops the handle. + **/ + public function stop():Result; +} \ No newline at end of file diff --git a/std/eval/luv/Handle.hx b/std/eval/luv/Handle.hx new file mode 100644 index 00000000..53524baa --- /dev/null +++ b/std/eval/luv/Handle.hx @@ -0,0 +1,85 @@ +package eval.luv; + +@:coreType abstract SocketHandle {} + +/** + Handles. + + @see https://aantron.github.io/luv/luv/Luv/Handle +**/ +@:coreType abstract Handle { + /** + Closes the given handle. + **/ + extern static public function close(handle:Handle, callback:()->Void):Void; + + /** + Returns `true` if the handle is active, `false` otherwise. + **/ + static public function isActive(handle:Handle):Bool; + + /** + Returns `true` if the handle is closing or closed, `false` otherwise. + + Note: This function should only be used between the initialization of + the handle and the arrival of the close callback. + **/ + static public function isClosing(handle:Handle):Bool; + + /** + Reference the given handle. + + @see https://aantron.github.io/luv/luv/Luv/Handle/#val-ref + **/ + static public function ref(handle:Handle):Void; + + /** + Un-reference the given handle. + + @see https://aantron.github.io/luv/luv/Luv/Handle/#val-unref + **/ + static public function unref(handle:Handle):Void; + + /** + Returns `true` if the handle referenced, `false` otherwise. + + @see https://aantron.github.io/luv/luv/Luv/Handle/#val-has_ref + **/ + static public function hasRef(handle:Handle):Bool; + + /** + Gets the size of the OS send buffer for a socket. + + @see https://aantron.github.io/luv/luv/Luv/Handle/#val-send_buffer_size + **/ + static public function sendBufferSize(handle:SocketHandle):Result; + + /** + Sets the size of the OS send buffer for a socket. + + @see https://aantron.github.io/luv/luv/Luv/Handle/#val-set_send_buffer_size + **/ + static public function setSendBufferSize(handle:SocketHandle, size:Int):Result; + + /** + Gets the size of the OS receive buffer for a socket. + + @see https://aantron.github.io/luv/luv/Luv/Handle/#val-recv_buffer_size + **/ + static public function recvBufferSize(handle:SocketHandle):Result; + + /** + Sets the size of the OS receive buffer for a socket. + + @see https://aantron.github.io/luv/luv/Luv/Handle/#val-set_recv_buffer_size + **/ + static public function setRecvBufferSize(handle:SocketHandle, size:Int):Result; + +// TODO + // /** + // Retrieves the file descriptor associated with the handle. + + // @see https://aantron.github.io/luv/luv/Luv/Handle/#val-fileno + // **/ + // static public function fileno(handle:FileNo):Result; +} \ No newline at end of file diff --git a/std/eval/luv/Idle.hx b/std/eval/luv/Idle.hx new file mode 100644 index 00000000..388fd664 --- /dev/null +++ b/std/eval/luv/Idle.hx @@ -0,0 +1,26 @@ +package eval.luv; + +/** + Per-iteration callback. + + @see https://aantron.github.io/luv/luv/Luv/Idle +**/ +@:using(eval.luv.Handle) +@:coreType abstract Idle to Handle { + /** + Allocate and initialize an idle handle. + + The handle should be cleaned up with `eval.luv.Handle.close` when no longer needed. + **/ + static public function init(loop:Loop):Result; + + /** + Starts the handle with the given callback. + **/ + public function start(callback:()->Void):Result; + + /** + Stops the handle. + **/ + public function stop():Result; +} \ No newline at end of file diff --git a/std/eval/luv/Loop.hx b/std/eval/luv/Loop.hx new file mode 100644 index 00000000..2122211c --- /dev/null +++ b/std/eval/luv/Loop.hx @@ -0,0 +1,93 @@ +package eval.luv; + +enum abstract RunMode(Int) { + /** Runs the event loop until there are no more active and referenced handles or requests. */ + var DEFAULT = 0; + /** Poll for i/o once. Note that this mode blocks if there are no pending callbacks. */ + var ONCE = 1; + /** Poll for i/o once but don't block if there are no pending callbacks. */ + var NOWAIT = 2; +} + +/** + Configuration options. + @see http://docs.libuv.org/en/v1.x/loop.html#c.uv_loop_configure +**/ +enum abstract LoopOption(Int) { + extern static public final sigprof:Int; + + var LOOP_BLOCK_SIGNAL:LoopOption = 0; + var METRICS_IDLE_TIME:LoopOption = 1; +} + +/** + Event loops. + + @see https://aantron.github.io/luv/luv/Luv/Loop + + Haxe event loops define an implicit cast to libuv loops. That is, you can use + `sys.thread.Thread.current().events` in any place where `eval.luv.Loop` is + expected. +**/ +@:coreType abstract Loop { + @:from + static inline function fromHaxeEventLoop(events:sys.thread.EventLoop):Loop { + return events.handle; + } + + /** + Returns the default event loop. + **/ + static public function defaultLoop():Loop; + + /** + Allocates and initializes a new event loop. + **/ + static public function init():Result; + + /** + Releases any state libuv is holding on to. + + Normally there's no need to do this manually. + + Warning! Only call `Loop.libraryShutdown()` once. + Warning! Don’t call `Loop.libraryShutdown()` when there are still event loops or I/O requests active. + Warning! Don’t call libuv functions after calling `Loop.libraryShutdown()`. + **/ + static public function libraryShutdown():Void; + + /** + Runs an event loop. + **/ + public function run(mode:RunMode):Bool; + + /** + Releases resources associated with an event loop. + **/ + public function close():Result; + + /** + Indicates whether the loop is monitoring any activity. + **/ + public function alive():Bool; + + /** + Stops an event loop as soon as possible. + **/ + public function stop():Void; + + /** + Returns the cached loop timestamp. + **/ + public function now():eval.integers.UInt64; + + /** + Updates the cached loop timestamp. + **/ + public function updateTime():Void; + + /** + Sets the loop option. + **/ + public function configure(option:LoopOption, value:T):Result; +} \ No newline at end of file diff --git a/std/eval/luv/LuvException.hx b/std/eval/luv/LuvException.hx new file mode 100644 index 00000000..bf5f3a0f --- /dev/null +++ b/std/eval/luv/LuvException.hx @@ -0,0 +1,19 @@ +package eval.luv; + +/** + Exceptions thrown by functions in `eval.luv` package. +**/ +class LuvException extends haxe.Exception { + /** + The error. + **/ + public final error:UVError; + + /** + Instantiates an error with given message and position. + **/ + public function new(error:UVError, ?message:String, ?previous:haxe.Exception) { + super(message == null ? error.toString() : message, previous); + this.error = error; + } +} \ No newline at end of file diff --git a/std/eval/luv/Metrics.hx b/std/eval/luv/Metrics.hx new file mode 100644 index 00000000..2bb63a68 --- /dev/null +++ b/std/eval/luv/Metrics.hx @@ -0,0 +1,13 @@ +package eval.luv; + +/** + Metrics. + + @see https://aantron.github.io/luv/luv/Luv/Metrics +**/ +extern class Metrics { + /** + Retrieves the amount of time the loop has been blocked waiting in the kernel. + **/ + static function idleTime(loop:Loop):eval.integers.UInt64; +} \ No newline at end of file diff --git a/std/eval/luv/Mutex.hx b/std/eval/luv/Mutex.hx new file mode 100644 index 00000000..35f06bb3 --- /dev/null +++ b/std/eval/luv/Mutex.hx @@ -0,0 +1,35 @@ +package eval.luv; + +/** + Mutexes. + + @see https://aantron.github.io/luv/luv/Luv/Mutex +**/ +@:coreType abstract Mutex { + /** + Allocates and initializes a mutex. + **/ + static public function init(?recursive:Bool):Result; + + /** + Cleans up a mutex. + **/ + public function destroy():Void; + + /** + Takes the mutex. + + The calling thread is blocked until it obtains the mutex. + **/ + public function lock():Void; + + /** + Tries to take the mutex without blocking. + **/ + public function tryLock():Result; + + /** + Releases the mutex. + **/ + public function unlock():Void; +} \ No newline at end of file diff --git a/std/eval/luv/Network.hx b/std/eval/luv/Network.hx new file mode 100644 index 00000000..611d35f1 --- /dev/null +++ b/std/eval/luv/Network.hx @@ -0,0 +1,36 @@ +package eval.luv; + +typedef InterfaceAddress = { + var name:String; + var isInternal:Bool; + var physical:NativeString; + var address:SockAddr; + var netmask:SockAddr; +} + +/** + Network interfaces and hostname. + + @see https://aantron.github.io/luv/luv/Luv/Network +**/ +extern class Network { + /** + Lists network interface addresses. + **/ + static function interfaceAddresses():Result>; + + /** + Retrieves a network interface name. + **/ + static function ifIndexToName(index:Int):Result; + + /** + Retrieves a network interface identifier suitable for use in an IPv6 scoped address. + **/ + static function ifIndexToIid(index:Int):Result; + + /** + Evaluates to the system's hostname. + **/ + static function getHostName():Result; +} \ No newline at end of file diff --git a/std/eval/luv/Once.hx b/std/eval/luv/Once.hx new file mode 100644 index 00000000..6202d45f --- /dev/null +++ b/std/eval/luv/Once.hx @@ -0,0 +1,18 @@ +package eval.luv; + +/** + Once-only initialization. + + @see https://aantron.github.io/luv/luv/Luv/Once +**/ +@:coreType abstract Once { + /** + Allocates and initializes a once-only barrier. + **/ + static public function init():Result; + + /** + Guards the given callback to be called only once. + **/ + public function once(callback:()->Void):Void; +} \ No newline at end of file diff --git a/std/eval/luv/OsFd.hx b/std/eval/luv/OsFd.hx new file mode 100644 index 00000000..a8652fa1 --- /dev/null +++ b/std/eval/luv/OsFd.hx @@ -0,0 +1,6 @@ +package eval.luv; + +/** + @see https://aantron.github.io/luv/luv/Luv/Os_fd/Fd +**/ +@:coreType abstract OsFd {} \ No newline at end of file diff --git a/std/eval/luv/OsSocket.hx b/std/eval/luv/OsSocket.hx new file mode 100644 index 00000000..7e0eca67 --- /dev/null +++ b/std/eval/luv/OsSocket.hx @@ -0,0 +1,6 @@ +package eval.luv; + +/** + @see https://aantron.github.io/luv/luv/Luv/Os_fd/Socket +**/ +@:coreType abstract OsSocket {} \ No newline at end of file diff --git a/std/eval/luv/Passwd.hx b/std/eval/luv/Passwd.hx new file mode 100644 index 00000000..87e506bd --- /dev/null +++ b/std/eval/luv/Passwd.hx @@ -0,0 +1,21 @@ +package eval.luv; + +typedef PasswdData = { + var username:String; + var uid:Int; + var gid:Int; + var shell:Null; + var homedir:NativeString; +} + +/** + Current user information. + + @see https://aantron.github.io/luv/luv/Luv/Passwd +**/ +extern class Passwd { + /** + Gets passwd entry for the current user. + **/ + static function getPasswd():Result; +} \ No newline at end of file diff --git a/std/eval/luv/Path.hx b/std/eval/luv/Path.hx new file mode 100644 index 00000000..758c94b4 --- /dev/null +++ b/std/eval/luv/Path.hx @@ -0,0 +1,37 @@ +package eval.luv; + +import eval.integers.Int64; +import eval.integers.UInt64; + +/** + Relevant directories. + + @see https://aantron.github.io/luv/luv/Luv/Path +**/ +extern class Path { + /** + Evaluates to the executable's path. + It's always the path to the Haxe compiler. + **/ + static function exePath():Result; + + /** + Evaluates to the current working directory. + **/ + static function cwd():Result; + + /** + Changes the current working directory. + **/ + static function chdir(dir:NativeString):Result; + + /** + Evaluates to the path of the home directory. + **/ + static function homedir():Result; + + /** + Evaluates to the path of the temporary directory. + **/ + static function tmpdir():Result; +} \ No newline at end of file diff --git a/std/eval/luv/Pid.hx b/std/eval/luv/Pid.hx new file mode 100644 index 00000000..573f9c62 --- /dev/null +++ b/std/eval/luv/Pid.hx @@ -0,0 +1,18 @@ +package eval.luv; + +/** + Process ids. + + @see https://aantron.github.io/luv/luv/Luv/Pid +**/ +extern class Pid { + /** + Evaluates to the pid of the current process. + **/ + static function getPid():Int; + + /** + Evaluates to the pid of the parent process. + **/ + static function getPPid():Int; +} \ No newline at end of file diff --git a/std/eval/luv/Pipe.hx b/std/eval/luv/Pipe.hx new file mode 100644 index 00000000..bc04e936 --- /dev/null +++ b/std/eval/luv/Pipe.hx @@ -0,0 +1,77 @@ +package eval.luv; + +enum abstract PipeMode(Int) { + var READ = 0; + var WRITE = 1; + var READ_WRITE = 2; +} + +enum ReceiveHandle { + NONE; + TCP(associate:(tcp:Tcp)->Result); + PIPE(associate:(pipe:Pipe)->Result); +} + +/** + Pipes + + @see https://aantron.github.io/luv/luv/Luv/Pipe +**/ +@:using(eval.luv.Handle) +@:using(eval.luv.Stream) +@:coreType abstract Pipe to Handle to Stream to Stream.TStream to Handle.SocketHandle { + /** + Allocates and initializes a pipe. + + The pipe is not yet connected to anything at this point. + + The handle should be cleaned up with `eval.luv.Handle.close` when no longer needed. + **/ + static public function init(loop:Loop, forHandlePassing:Bool = false):Result; + + /** + Assigns a pipe a name or an address. + **/ + public function bind(nameOrAddress:NativeString):Result; + + /** + Connects to the pipe at the given name or address. + **/ + public function connect(target:NativeString, callback:(result:Result)->Void):Void; + + /** + Retrieves the name or address assigned to the pipe. + **/ + public function getSockName():Result; + + /** + Retrieves the name or address of the pipe's peer. + **/ + public function getPeerName():Result; + + /** + Set the number of pending pipe instance handles when the pipe server is + waiting for connections. + **/ + public function pendingInstances(amount:Int):Void; + + /** + Receives a file descriptor over the given pipe. + + File descriptors are sent using the `sendHandle` argument of `eval.luv.Stream.write2`. + On the receiving end, call `eval.luv.Stream.readStart`. When that function + calls its callback, there may be file descriptors in the pipe, in addition + to the ordinary data provided to the callback. + + To check, call this function `eval.luv.Pipe.recieveHandle` in a loop until + it returns `NONE`. Each time it returns `TCP(associate)` or `PIPE(associate)`, + create an appropriate handle using either `eval.luv.TCP.init` or `eval.uv.Pipe.init`, + and call `associate` to receive the file descriptor and associate it with handle. + **/ + public function receiveHandle():ReceiveHandle; + + /** + Sets pipe permissions. + **/ + public function chmod(mode:PipeMode):Result; +} \ No newline at end of file diff --git a/std/eval/luv/Prepare.hx b/std/eval/luv/Prepare.hx new file mode 100644 index 00000000..c74de431 --- /dev/null +++ b/std/eval/luv/Prepare.hx @@ -0,0 +1,26 @@ +package eval.luv; + +/** + Pre-I/O callback. + + @see https://aantron.github.io/luv/luv/Luv/Prepare +**/ +@:using(eval.luv.Handle) +@:coreType abstract Prepare to Handle { + /** + Allocate and initialize a prepare handle. + + The handle should be cleaned up with `eval.luv.Handle.close` when no longer needed. + **/ + static public function init(loop:Loop):Result; + + /** + Starts the handle with the given callback. + **/ + public function start(callback:()->Void):Result; + + /** + Stops the handle. + **/ + public function stop():Result; +} \ No newline at end of file diff --git a/std/eval/luv/Process.hx b/std/eval/luv/Process.hx new file mode 100644 index 00000000..9bbf4b9e --- /dev/null +++ b/std/eval/luv/Process.hx @@ -0,0 +1,89 @@ +package eval.luv; + +import eval.integers.Int64; + +/** + File descriptor redirections for use with `eval.luv.Process.spawn` +**/ +@:coreType abstract Redirection {} + +/** + Options for spawning the process. +**/ +typedef ProcessOptions = { + var ?onExit:(p:Process, exitStatus:Int64, termSignal:Int)->Void; + var ?environment:Map; + var ?workingDirectory:NativeString; + var ?redirect:Array; + var ?uid:Int; + var ?gid:Int; + var ?windowsVerbatimArguments:Bool; + var ?detached:Bool; + var ?windowsHide:Bool; + var ?windowsHideConsole:Bool; + var ?windowsHideGui:Bool; +} + +/** + Subprocesses. + + @see https://aantron.github.io/luv/luv/Luv/Process +**/ +@:using(eval.luv.Handle) +@:coreType abstract Process to Handle { + extern static public final stdin:Int; + extern static public final stdout:Int; + extern static public final stderr:Int; + + /** + Causes `fd` in the child to be connected to `toParentPipe` in the parent. + + Binds `UV_CREATE_PIPE`. + + `readableInChild` sets `UV_READABLE_PIPE`, and `writableInChild` sets `UV_WRITABLE_PIPE`. + + `overlapped` sets `UV_OVERLAPPED_PIPE`. + **/ + static public function toParentPipe(fd:Int, parentPipe:Pipe, readableInChild:Bool, writableInChild:Bool, overlapped:Bool):Redirection; + + /** + Causes `fd` in the child to be connected to the same device or peer as `fromParentFd` in the parent. + + Binds `UV_INHERIT_FD` + **/ + static public function inheritFd(fd:Int, fromParentFd:Int):Redirection; + + /** + Same as `eval.luv.Process.inheritFd`, but takes an `eval.luv.Stream` for the parent file descriptor. + + Binds `UV_INHERIT_STREAM`. + **/ + static public function inheritStream(fd:Int, fromParentStream:Stream):Redirection; + + /** + Starts a process. + + The handle should be cleaned up with `eval.luv.Handle.close` when no longer needed. + **/ + static public function spawn(loop:Loop, cmd:NativeString, args:Array, ?options:ProcessOptions):Result; + + /** + Disables (tries) file descriptor inheritance for inherited descriptors. + **/ + static public function disableStdioInheritance():Void; + + /** + Sends the given signal to the process with the given pid. + **/ + static public function killPid(pid:Int, sigNum:Signal.SigNum):Result; + + /** + Sends the given signal to the process. + **/ + public function kill(sigNum:Signal.SigNum):Result; + + /** + Evaluates to the pid of the process. + **/ + public function pid():Int; +} \ No newline at end of file diff --git a/std/eval/luv/Random.hx b/std/eval/luv/Random.hx new file mode 100644 index 00000000..de159362 --- /dev/null +++ b/std/eval/luv/Random.hx @@ -0,0 +1,26 @@ +package eval.luv; + +@:forward +abstract RandomRequest(Request) to Request {} + +/** + System entropy source. + + @see https://aantron.github.io/luv/luv/Luv/Random +**/ +extern class Random { + + static function createRequest():RandomRequest; + + /** + Fills the given buffer with bits from the system entropy source. + **/ + static function random(loop:Loop, buffer:Buffer, ?request:RandomRequest, callback:(result:Result)->Void):Void; +} + +extern class RandomSync { + /** + Fills the given buffer with bits from the system entropy source. + **/ + static function random(buffer:Buffer):Result; +} \ No newline at end of file diff --git a/std/eval/luv/Request.hx b/std/eval/luv/Request.hx new file mode 100644 index 00000000..ef3c1466 --- /dev/null +++ b/std/eval/luv/Request.hx @@ -0,0 +1,13 @@ +package eval.luv; + +/** + Requests. + + @see https://aantron.github.io/luv/luv/Luv/Request +**/ +@:coreType abstract Request { + /** + Tries to cancel a pending request. + **/ + public function cancel():Result; +} \ No newline at end of file diff --git a/std/eval/luv/Resource.hx b/std/eval/luv/Resource.hx new file mode 100644 index 00000000..40d575cb --- /dev/null +++ b/std/eval/luv/Resource.hx @@ -0,0 +1,78 @@ +package eval.luv; + +import eval.integers.UInt64; +import eval.integers.Int64; + +typedef RUsage = { + var utime:{sec:Int64, usec:Int64}; + var stime:{sec:Int64, usec:Int64}; + var maxrss:UInt64; + var ixrss:UInt64; + var idrss:UInt64; + var isrss:UInt64; + var minflt:UInt64; + var majflt:UInt64; + var nswap:UInt64; + var inblock:UInt64; + var oublock:UInt64; + var msgsnd:UInt64; + var msgrcv:UInt64; + var nsignals:UInt64; + var nvcsw:UInt64; + var nivcsw:UInt64; +} + +/** + Resource usage. + + @see https://aantron.github.io/luv/luv/Luv/Resource +**/ +extern class Resource { + /** + Evaluates to the current uptime. + **/ + static function uptime():Result; + + /** + Evaluates to the load average. + **/ + static function loadAvg():Array; + + /** + Evaluates to the amount of free memory, in bytes. + **/ + static function freeMemory():UInt64; + + /** + Evaluates to the total amount of memory, in bytes. + **/ + static function totalMemory():UInt64; + + /** + Gets the amount of memory available to the process (in bytes) based on + limits imposed by the OS. + If there is no such constraint returns `null` + **/ + static function constrainedMemory():Null; + + /** + Evaluates to the priority of the process with the given pid. + **/ + static function getPriority(pid:Int):Result; + + /** + Sets the priority of the process with the given pid. + **/ + static function setPriority(pid:Int, priority:Int):Result; + + /** + Evaluates to the resident set size for the current process. + **/ + static function residentSetMemory(pid:Int):Result; + + /** + Gets the resource usage measures for the current process. + **/ + static function getRUsage():Result; + +} \ No newline at end of file diff --git a/std/eval/luv/Result.hx b/std/eval/luv/Result.hx new file mode 100644 index 00000000..e48d34ee --- /dev/null +++ b/std/eval/luv/Result.hx @@ -0,0 +1,40 @@ +package eval.luv; + +/** + Outcome of an operation. +**/ +@:using(eval.luv.Result.ResultTools) +enum Result { + /** Operation completed successfully. **/ + Ok(value:T); + /** Operation failed. **/ + Error(e:UVError); +} + +enum abstract NoData(Dynamic) { + var NoData = null; +} + +class ResultTools { + /** + Returns the result value on success or throws `eval.luv.LuvException` + on failure. + **/ + static public inline function resolve(result:Result):T { + switch result { + case Ok(v): return v; + case Error(e): throw new LuvException(e); + } + } + + /** + Returns `true` if the result is `Ok`. + Returns `false` if the result is `Error`. + **/ + static public inline function isOk(result:Result):Bool { + return switch result { + case Ok(_): true; + case Error(_): false; + } + } +} \ No newline at end of file diff --git a/std/eval/luv/RwLock.hx b/std/eval/luv/RwLock.hx new file mode 100644 index 00000000..2fd943ed --- /dev/null +++ b/std/eval/luv/RwLock.hx @@ -0,0 +1,48 @@ +package eval.luv; + +/** + Read-write locks. + + @see https://aantron.github.io/luv/luv/Luv/Rwlock +**/ +@:coreType abstract RwLock { + /** + Allocates and initializes a read-write lock. + **/ + static public function init():Result; + + /** + Cleans up a read-write lock. + **/ + public function destroy():Void; + + /** + Takes a read-write lock for reading (shared access). + **/ + public function rdLock():Void; + + /** + Tries to take a read-write lock for reading without blocking. + **/ + public function rdTryLock():Result; + + /** + Releases a read-write lock after it was taken for reading. + **/ + public function rdUnlock():Void; + + /** + Takes a read-write lock for writing (exclusive access). + **/ + public function wrLock():Void; + + /** + Tries to take a read-write lock for writing without blocking. + **/ + public function wrTryLock():Result; + + /** + Releases a read-write lock after it was taken for writing. + **/ + public function wrUnlock():Void; +} \ No newline at end of file diff --git a/std/eval/luv/Semaphore.hx b/std/eval/luv/Semaphore.hx new file mode 100644 index 00000000..bcbc4a36 --- /dev/null +++ b/std/eval/luv/Semaphore.hx @@ -0,0 +1,33 @@ +package eval.luv; + +/** + Semaphores. + + @see https://aantron.github.io/luv/luv/Luv/Semaphore +**/ +@:coreType abstract Semaphore { + /** + Allocates and initializes a read-write lock. + **/ + static public function init(value:Int):Result; + + /** + Cleans up a semaphore. + **/ + public function destroy():Void; + + /** + Increments a semaphore. + **/ + public function post():Void; + + /** + Decrements a semaphore. + **/ + public function wait():Void; + + /** + Tries to decrement a semaphore without blocking. + **/ + public function tryWait():Result; +} \ No newline at end of file diff --git a/std/eval/luv/Signal.hx b/std/eval/luv/Signal.hx new file mode 100644 index 00000000..5699c854 --- /dev/null +++ b/std/eval/luv/Signal.hx @@ -0,0 +1,57 @@ +package eval.luv; + +/** + For the moment, the signals exposed are those that are both present on Unix + and present or emulated by libuv on Windows. + + You can also provide a plain integer signal code instead of the values of + this enum. + + @see https://aantron.github.io/luv/luv/Luv/Signal#signals +**/ +extern enum abstract SigNum(Int) from Int to Int { + var SIGABRT; + var SIGFPE; + var SIGHUP; + var SIGILL; + var SIGINT; + var SIGKILL; + var SIGSEGV; + var SIGTERM; + var SIGWINCH; +} + +/** + Signals. + + @see https://aantron.github.io/luv/luv/Luv/Signal +**/ +@:using(eval.luv.Handle) +@:coreType abstract Signal to Handle { + /** + Allocates and initializes a signal handle. + + The handle should be cleaned up with `eval.luv.Handle.close` when no longer needed. + **/ + static public function init(loop:Loop):Result; + + /** + Starts the signal handle. + **/ + public function start(sigNum:SigNum, callback:()->Void):Result; + + /** + Like `eval.luv.Signal.start`, but the handle is stopped after one callback call. + **/ + public function startOneshot(sigNum:SigNum, callback:()->Void):Result; + + /** + Stops the signal handle. + **/ + public function stop():Result; + + /** + Evaluates to the signal number associated with the handle. + **/ + public function signum():Int; +} \ No newline at end of file diff --git a/std/eval/luv/SockAddr.hx b/std/eval/luv/SockAddr.hx new file mode 100644 index 00000000..0fb0759e --- /dev/null +++ b/std/eval/luv/SockAddr.hx @@ -0,0 +1,47 @@ +package eval.luv; + +/** + Network address families. +**/ +enum AddressFamily { + UNSPEC; + INET; + INET6; + OTHER(i:Int); +} + +/** + Socket types. +**/ +enum SocketType { + STREAM; + DGRAM; + RAW; + OTHER(i:Int); +} + +/** + Binds `struct sockaddr`. + + @see https://aantron.github.io/luv/luv/Luv/Sockaddr +**/ +@:coreType abstract SockAddr { + /** Extracts the port in a network address. */ + public var port(get,never):Null; + function get_port():Null; + + /** + Converts a string and port number to an IPv4 struct sockaddr. + **/ + static public function ipv4(host:String, port:Int):Result; + + /** + Converts a string and port number to an IPv6 struct sockaddr. + **/ + static public function ipv6(host:String, port:Int):Result; + + /** + Converts a network address to a string. + **/ + public function toString():String; +} \ No newline at end of file diff --git a/std/eval/luv/Stream.hx b/std/eval/luv/Stream.hx new file mode 100644 index 00000000..4768735c --- /dev/null +++ b/std/eval/luv/Stream.hx @@ -0,0 +1,111 @@ +package eval.luv; + +@:coreType abstract TStream to Stream {} +// typedef TStream = Stream; + +enum SendHandle { + TCP(tcp:Tcp); + PIPE(pipe:Pipe); +} + +/** + Streams. + + @see https://aantron.github.io/luv/luv/Luv/Stream +**/ +@:coreType abstract Stream to Handle { + /** + Shuts down the write side of the stream. + **/ + extern static public function shutdown(stream:Stream, callback:(result:Result)->Void):Void; + + /** + Starts listening for incoming connections. + + `backlog` indicates the number of connections the kernel might queue. + When a new incoming connection is received the `callback` is called. + **/ + extern static public function listen(stream:Stream, callback:(result:Result)->Void, ?backlog:Int):Void; + + /** + This call is used in conjunction with `Stream.listen()` to accept incoming + connections. Call this function after receiving a `callback` of `listen(callback)` + to accept the connection. Before calling this function the client handle + must be initialized. + + When the `callback` of `listen(callback)` is called it is guaranteed that + this function will complete successfully the first time. + + `client` should be a freshly-initialized stream. + **/ + extern static public function accept(server:TStream, client:TStream):Result; + + /** + Calls the `callback` whenever data is available on the stream. + + The amount of data read is equal to the length of the buffer passed to + the `callback`. `allocate` is called immediately before each call to the + main `callback`, to create buffer, into which the data will be read. + + The end of the stream (typically, when the remote peer closes or shuts down + the connection) is indicated by `UVError.UV_EOF` being passed to the `callback`. + Note that this behavior is different from `eval.luv.File.read`. + + Zero-length reads are possible, and do not indicate the end of stream. Instead, + they usually indicate `UVError.UV_EAGAIN` inside libuv; libuv still calls the + `callback` in order to give the C user a chance to deallocate the data buffer. + This is not usually an issue in OCaml (which is the backend for eval target of + Haxe), so a wrapper of this function can usually simply ignore zero-length reads. + It is then also safe to convert `UVError.UV_EOF` to zero-length reads in a + higher-level API, for consistency with reading files, and in accordance with OS + API convention. + + To read only once, call `eval.luv.Stream.readStop` immediately, in the `callback`. + Otherwise, the main callback will be called repeatedly. + **/ + extern static public function readStart(stream:Stream, callback:(result:Result)->Void, ?allocate:(size:Int)->Buffer):Void; + + /** + Stops reading. + **/ + extern static public function readStop(stream:Stream):Result; + + /** + Writes the given buffer to the stream. + + The second argument passed to the `callback` is the number of bytes written. + libuv has an internal queue of writes, in part to implement retry. This means + that writes can be partial at the libuv API level, so it is possible to receive + both an `UVError` result, and for some data to have been successfully written. + **/ + extern static public function write(stream:Stream, data:Array, callback:(result:Result, bytesWritten:Int)->Void):Result; + + /** + Like `eval.luv.Stream.write`, but allows sending a TCP socket or pipe over the + stream. + **/ + extern static public function write2(stream:TStream, data:Array, sendHandle:SendHandle, callback:(result:Result, bytesWritten:Int)->Void):Result; + + /** + Same as `eval.luv.Stream.write()`, but won’t queue a write request if it can’t + be completed immediately. + + Returns the number of bytes written. + **/ + extern static public function tryWrite(stream:Stream, data:Array):Result; + + /** + Indicates whether the stream is readable (has data). + **/ + extern static public function isReadable(stream:Stream):Bool; + + /** + Indicates whether the stream is writable (has space in buffers). + **/ + extern static public function isWritable(stream:Stream):Bool; + + /** + Sets the blocking mode of the stream. + **/ + extern static public function setBlocking(stream:Stream, block:Bool):Result; +} \ No newline at end of file diff --git a/std/eval/luv/SystemInfo.hx b/std/eval/luv/SystemInfo.hx new file mode 100644 index 00000000..8c7574dd --- /dev/null +++ b/std/eval/luv/SystemInfo.hx @@ -0,0 +1,39 @@ +package eval.luv; + +import eval.integers.UInt64; + +typedef CpuInfo = { + var model:String; + var speed:Int; + var times:{ + var user:UInt64; + var nice:UInt64; + var sys:UInt64; + var idle:UInt64; + var irq:UInt64; + }; +} + +typedef Uname = { + var sysname:String; + var release:String; + var version:String; + var machine:String; +} + +/** + System information. + + @see https://aantron.github.io/luv/luv/Luv/System_info +**/ +extern class SystemInfo { + /** + Gets information about the CPUs on the system. + **/ + static function cpuInfo():Result>; + + /** + Gets information about the CPUs on the system. + **/ + static function uname():Result; +} \ No newline at end of file diff --git a/std/eval/luv/Tcp.hx b/std/eval/luv/Tcp.hx new file mode 100644 index 00000000..33eef326 --- /dev/null +++ b/std/eval/luv/Tcp.hx @@ -0,0 +1,62 @@ +package eval.luv; + +import haxe.ds.Option; +import eval.luv.SockAddr; + +/** + TCP sockets. + + @see https://aantron.github.io/luv/luv/Luv/TCP +**/ +@:using(eval.luv.Handle) +@:using(eval.luv.Stream) +@:coreType abstract Tcp to Handle to Stream to Stream.TStream to Handle.SocketHandle { + /** + Allocates and initializes a TCP stream. + + The stream is not yet connected or listening. + + The handle should be cleaned up with `eval.luv.Handle.close` when no longer needed. + **/ + static public function init(loop:Loop, ?domain:AddressFamily):Result; + + /** + Sets TCP_NODELAY. + **/ + public function noDelay():Result; + + /** + Sets the TCP keepalive. + **/ + public function keepAlive(value:Option):Result; + + /** + Sets simultaneous accept. + **/ + public function simultaneousAccepts(value:Bool):Result; + + /** + Assigns an address to the TCP socket. + **/ + public function bind(addr:SockAddr, ipv6Only:Bool = false):Result; + + /** + Retrieves the address assigned to the TCP socket. + **/ + public function getSockName():Result; + + /** + Retrieves the address of the TCP socket's peer. + **/ + public function getPeerName():Result; + + /** + Connects to a host. + **/ + public function connect(addr:SockAddr, callback:(result:Result)->Void):Void; + + /** + Resets the connection. + **/ + public function closeReset(callback:(result:Result)->Void):Void; +} \ No newline at end of file diff --git a/std/eval/luv/Thread.hx b/std/eval/luv/Thread.hx new file mode 100644 index 00000000..6dd406ac --- /dev/null +++ b/std/eval/luv/Thread.hx @@ -0,0 +1,34 @@ +package eval.luv; + +/** + Threads. + + @see https://aantron.github.io/luv/luv/Luv/Thread + + `eval.luv` integrates libuv with the OCaml runtime lock. This means that, as + in any other OCaml program, two threads cannot be running OCaml code at the + same time. Thus, two threads cannot be running Haxe code at the same time + because eval interpreter is written in OCaml. + However, `eval.luv` releases the lock when calling a potentially-blocking libuv API, + so that other threads can run while the calling thread is blocked. In particular, + the lock is released during calls to `eval.luv.Loop.run`, which means that other + threads can run in between when you make a call to a non-blocking API, and when + its callback is called by libuv. +**/ +@:coreType abstract Thread { + /** + Returns the representation of the calling thread. + **/ + static public function self():Thread; + + /** + Starts a new thread, which will run the given function. + **/ + static public function create(fn:()->Void, ?stackSize:Int):Result; + + /** + Waits for the thread to terminate. + **/ + public function join():Result; + +} \ No newline at end of file diff --git a/std/eval/luv/ThreadPool.hx b/std/eval/luv/ThreadPool.hx new file mode 100644 index 00000000..4c6fd7cf --- /dev/null +++ b/std/eval/luv/ThreadPool.hx @@ -0,0 +1,31 @@ +package eval.luv; + +@:forward +abstract ThreadPoolRequest(Request) to Request {} + +/** + Thread pool. + + @see https://aantron.github.io/luv/luv/Luv/Thread_pool +**/ +extern class ThreadPool { + + static function createRequest():ThreadPoolRequest; + + /** + Schedules a function to be called by a thread in the thread pool. + + `work` is the function that will be called in the thread pool. + `callback` will be called by the `loop` after `work` completes, or + immediately, in case there is an error scheduling `work`. + **/ + static function queueWork(loop:Loop, ?request:ThreadPoolRequest, work:()->Void, callback:(result:Result)->Void):Void; + + /** + Sets thread pool size. + + This function should be called as soon during process startup as possible. + **/ + static function setSize(size:Int, ?ifNotAlreadySet:Bool):Void; + +} \ No newline at end of file diff --git a/std/eval/luv/Time.hx b/std/eval/luv/Time.hx new file mode 100644 index 00000000..d43dfa19 --- /dev/null +++ b/std/eval/luv/Time.hx @@ -0,0 +1,27 @@ +package eval.luv; + +import eval.integers.Int64; +import eval.integers.UInt64; + +/** + Current time. + + @see https://aantron.github.io/luv/luv/Luv/Time +**/ +extern class Time { + /** + Get time. + **/ + static function getTimeOfDay():Result<{sec:Int64, usec:Int}>; + + /** + Samples the high-resolution timer. + **/ + static function hrTime():UInt64; + + /** + Suspends the calling thread for at least the given number of milliseconds. + **/ + static function sleep(duration:Int):Void; + +} \ No newline at end of file diff --git a/std/eval/luv/Timer.hx b/std/eval/luv/Timer.hx new file mode 100644 index 00000000..8b4f591f --- /dev/null +++ b/std/eval/luv/Timer.hx @@ -0,0 +1,40 @@ +package eval.luv; + +/** + Timers. + + @see https://aantron.github.io/luv/luv/Luv/Timer +**/ +@:using(eval.luv.Handle) +@:coreType abstract Timer to Handle { + /** The timer repeat interval. */ + public var repeat(get,set):Int; + function get_repeat():Int; + function set_repeat(v:Int):Int; + + /** Evaluates to the time until the timer expires, or zero if it has already expired. */ + public var dueIn(get,never):Int; + function get_dueIn():Int; + + /** + Allocate and initialize an idle handle. + + The handle should be cleaned up with `eval.luv.Handle.close` when no longer needed. + **/ + static public function init(loop:Loop):Result; + + /** + Starts a timer. + **/ + public function start(callback:()->Void, timeoutMs:Int, ?repeatMs:Int):Result; + + /** + Stops a timer. + **/ + public function stop():Result; + + /** + Restarts a timer. + **/ + public function again():Result; +} \ No newline at end of file diff --git a/std/eval/luv/Tty.hx b/std/eval/luv/Tty.hx new file mode 100644 index 00000000..58940483 --- /dev/null +++ b/std/eval/luv/Tty.hx @@ -0,0 +1,63 @@ +package eval.luv; + +enum abstract TtyMode(Int) { + var NORMAL = 0; + var RAW = 1; + var IO = 2; +} + +enum abstract VTermState(Int) { + var SUPPORTED = 0; + var UNSUPPORTED = 1; +} + +/** + Consoles. + + @see https://aantron.github.io/luv/luv/Luv/Tty +**/ +@:using(eval.luv.Handle) +@:using(eval.luv.Stream) +@:coreType abstract Tty to Handle to Stream to Stream.TStream { + /** + To be called when the program exits. + Resets TTY settings to default values for the next process to take over. + **/ + static public function resetMode():Result; + + /** + Controls whether console virtual terminal sequences are processed by libuv + or console. Useful in particular for enabling ConEmu support of ANSI X3.64 + and Xterm 256 colors. Otherwise Windows10 consoles are usually detected + automatically. + + This function is only meaningful on Windows systems. On Unix it is silently + ignored. + **/ + static public function setVTermState(state:VTermState):Void; + + /** + Get the current state of whether console virtual terminal sequences are + handled by libuv or the console. + + This function is not implemented on Unix, where it returns `UVError.UV_ENOTSUP`. + **/ + static public function getVTermState():Result; + + /** + Allocates and initializes a TTY handle. + + The handle should be cleaned up with `eval.luv.Handle.close` when no longer needed. + **/ + static public function init(loop:Loop, file:File):Result; + + /** + Sets the TTY's mode. + **/ + public function setMode(mode:TtyMode):Result; + + /** + Retrieves the current window size. + **/ + public function getWinSize():Result<{width:Int, height:Int}>; +} \ No newline at end of file diff --git a/std/eval/luv/UVError.hx b/std/eval/luv/UVError.hx new file mode 100644 index 00000000..82389799 --- /dev/null +++ b/std/eval/luv/UVError.hx @@ -0,0 +1,187 @@ +package eval.luv; + +/** + Error handling. + + @see https://aantron.github.io/luv/luv/Luv/Error +**/ +enum abstract UVError(Int) { + /** argument list too long */ + var UV_E2BIG = 0; + /** permission denied */ + var UV_EACCES = 1; + /** address already in use */ + var UV_EADDRINUSE = 2; + /** address not available */ + var UV_EADDRNOTAVAIL = 3; + /** address family not supported */ + var UV_EAFNOSUPPORT = 4; + /** resource temporarily unavailable */ + var UV_EAGAIN = 5; + /** address family not supported */ + var UV_EAI_ADDRFAMILY = 6; + /** temporary failure */ + var UV_EAI_AGAIN = 7; + /** bad ai_flags value */ + var UV_EAI_BADFLAGS = 8; + /** invalid value for hints */ + var UV_EAI_BADHINTS = 9; + /** request canceled */ + var UV_EAI_CANCELED = 10; + /** permanent failure */ + var UV_EAI_FAIL = 11; + /** ai_family not supported */ + var UV_EAI_FAMILY = 12; + /** out of memory */ + var UV_EAI_MEMORY = 13; + /** no address */ + var UV_EAI_NODATA = 14; + /** unknown node or service */ + var UV_EAI_NONAME = 15; + /** argument buffer overflow */ + var UV_EAI_OVERFLOW = 16; + /** resolved protocol is unknown */ + var UV_EAI_PROTOCOL = 17; + /** service not available for socket type */ + var UV_EAI_SERVICE = 18; + /** socket type not supported */ + var UV_EAI_SOCKTYPE = 19; + /** connection already in progress */ + var UV_EALREADY = 20; + /** bad file descriptor */ + var UV_EBADF = 21; + /** resource busy or locked */ + var UV_EBUSY = 22; + /** operation canceled */ + var UV_ECANCELED = 23; + /** invalid Unicode character */ + // var UV_ECHARSET = 24; // not defined in Luv ocaml library + /** software caused connection abort */ + var UV_ECONNABORTED = 25; + /** connection refused */ + var UV_ECONNREFUSED = 26; + /** connection reset by peer */ + var UV_ECONNRESET = 27; + /** destination address required */ + var UV_EDESTADDRREQ = 28; + /** file already exists */ + var UV_EEXIST = 29; + /** bad address in system call argument */ + var UV_EFAULT = 30; + /** file too large */ + var UV_EFBIG = 31; + /** host is unreachable */ + var UV_EHOSTUNREACH = 32; + /** interrupted system call */ + var UV_EINTR = 33; + /** invalid argument */ + var UV_EINVAL = 34; + /** i/o error */ + var UV_EIO = 35; + /** socket is already connected */ + var UV_EISCONN = 36; + /** illegal operation on a directory */ + var UV_EISDIR = 37; + /** too many symbolic links encountered */ + var UV_ELOOP = 38; + /** too many open files */ + var UV_EMFILE = 39; + /** message too long */ + var UV_EMSGSIZE = 40; + /** name too long */ + var UV_ENAMETOOLONG = 41; + /** network is down */ + var UV_ENETDOWN = 42; + /** network is unreachable */ + var UV_ENETUNREACH = 43; + /** file table overflow */ + var UV_ENFILE = 44; + /** no buffer space available */ + var UV_ENOBUFS = 45; + /** no such device */ + var UV_ENODEV = 46; + /** no such file or directory */ + var UV_ENOENT = 47; + /** not enough memory */ + var UV_ENOMEM = 48; + /** machine is not on the network */ + var UV_ENONET = 49; + /** protocol not available */ + var UV_ENOPROTOOPT = 50; + /** no space left on device */ + var UV_ENOSPC = 51; + /** function not implemented */ + var UV_ENOSYS = 52; + /** socket is not connected */ + var UV_ENOTCONN = 53; + /** not a directory */ + var UV_ENOTDIR = 54; + /** directory not empty */ + var UV_ENOTEMPTY = 55; + /** socket operation on non-socket */ + var UV_ENOTSOCK = 56; + /** operation not supported on socket */ + var UV_ENOTSUP = 57; + /** operation not permitted */ + var UV_EPERM = 58; + /** broken pipe */ + var UV_EPIPE = 59; + /** protocol error */ + var UV_EPROTO = 60; + /** protocol not supported */ + var UV_EPROTONOSUPPORT = 61; + /** protocol wrong type for socket */ + var UV_EPROTOTYPE = 62; + /** result too large */ + var UV_ERANGE = 63; + /** read-only file system */ + var UV_EROFS = 64; + /** cannot send after transport endpoint shutdown */ + var UV_ESHUTDOWN = 65; + /** invalid seek */ + var UV_ESPIPE = 66; + /** no such process */ + var UV_ESRCH = 67; + /** connection timed out */ + var UV_ETIMEDOUT = 68; + /** text file is busy */ + var UV_ETXTBSY = 69; + /** cross-device link not permitted */ + var UV_EXDEV = 70; + /** unknown error */ + var UV_UNKNOWN = 71; + /** end of file */ + var UV_EOF = 72; + /** no such device or address */ + var UV_ENXIO = 73; + /** too many links */ + var UV_EMLINK = 74; + /** inappropriate ioctl for device */ + var UV_ENOTTY = 75; + /** inappropriate file type or format */ + var UV_EFTYPE = 76; + /** illegal byte sequence */ + var UV_EILSEQ = 77; + + /** + Converts a system error code to a libuv error. + **/ + extern static public function translateSysError(code:Int):UVError; + + /** + Setup a callback for unhandled exceptions. + + @see https://aantron.github.io/luv/luv/Luv/Error#val-set_on_unhandled_exception + **/ + extern static public function setOnUnhandledException(callback:(e:haxe.Exception)->Void):Void; + + /** + Returns the name of the given error. + **/ + extern public function errName():String; + + /** + Returns the error message corresponding to the given error. + **/ + extern public function toString():String; +} \ No newline at end of file diff --git a/std/eval/luv/Udp.hx b/std/eval/luv/Udp.hx new file mode 100644 index 00000000..1336006c --- /dev/null +++ b/std/eval/luv/Udp.hx @@ -0,0 +1,121 @@ +package eval.luv; + +import haxe.ds.Option; +import eval.luv.SockAddr; + +enum abstract UdpMembership(Int) { + var LEAVE_GROUP = 0; + var JOIN_GROUP = 1; +} + +enum abstract RecvFlag(Int) { + var PARTIAL = 0; + var MMSG_CHUNK = 1; + var MMSG_FREE = 2; +} + +/** + UDP sockets. + + @see https://aantron.github.io/luv/luv/Luv/UDP +**/ +@:using(eval.luv.Handle) +@:coreType abstract Udp to Handle to Handle.SocketHandle { + /** + Allocates and initializes a UDP socket. + + The handle should be cleaned up with `eval.luv.Handle.close` when no longer needed. + **/ + static public function init(loop:Loop, ?domain:AddressFamily, recvmmsg:Bool = false):Result; + + /** + Assigns an address to the UDP socket. + **/ + public function bind(addr:SockAddr, ipv6Only:Bool = false, reuseAddr:Bool = false):Result; + + /** + Assigns a peer address to the socket. + **/ + public function connect(addr:SockAddr):Result; + + /** + Retrieves the address assigned to the UDP socket. + **/ + public function getSockName():Result; + + /** + Sets multicast group membership. + **/ + public function setMembership(group:String, interfaceName:String, membership:UdpMembership):Result; + + /** + Sets source-specific multicast group membership. + **/ + public function setSourceMembership(group:String, interfaceName:String, source:String, membership:UdpMembership):Result; + + /** + Set multicast loopback. + **/ + public function setMulticastLoop(value:Bool):Result; + + /** + Set multicast TTL. + **/ + public function setMulticastTtl(value:Int):Result; + + /** + Sets the interface to be used for multicast. + **/ + public function setMulticastInterface(value:Int):Result; + + /** + Sets broadcast. + **/ + public function setBroadcast(value:Bool):Result; + + /** + Sets the TTL. + **/ + public function setTtl(value:Int):Result; + + /** + Sends a datagram. + + For connected UDP sockets, see `eval.luv.UDP.Connected.send`. + **/ + public function send(data:Array, addr:SockAddr, callback:(result:Result)->Void):Void; + + /** + Like `eval.luv.UDP.send`, but only attempts to send the datagram immediately. + **/ + public function trySend(data:Array, addr:SockAddr):Result; + + /** + Calls `callback` whenever a datagram is received on the UDP socket. + + @see https://aantron.github.io/luv/luv/Luv/UDP/index.html#val-recv_start + **/ + public function recvStart(callback:(result:Result<{data:Buffer, addr:Option, flags:Array}>, ?allocate:(size:Int)->Buffer)->Void):Void; + + /** + Stops the callback provided to `eval.luv.UDP.recvStart`. + **/ + public function recvStop():Result; + + /** + Evaluates to true if and only if the UDP was created with `recvmmsg = true` + and the platform supports recvmmsg(2). + **/ + public function usingRecvmmsg():Bool; + + /** + Number of bytes queued for sending. This field strictly shows how much + information is currently queued. + **/ + public function getSendQueueSize():Int; + + /** + Number of send requests currently in the queue awaiting to be processed. + **/ + public function getSendQueueCount():Int; +} \ No newline at end of file diff --git a/std/eval/luv/Version.hx b/std/eval/luv/Version.hx new file mode 100644 index 00000000..804925ec --- /dev/null +++ b/std/eval/luv/Version.hx @@ -0,0 +1,44 @@ +package eval.luv; + +/** + Version information for the vendored libuv. + + @see https://aantron.github.io/luv/luv/Luv/Version +**/ +extern class Version { + /** + Returns the libuv version as a string. + **/ + static function string():String; + + /** + libuv major version number. + **/ + static final major:Int; + + /** + libuv minor version number. + **/ + static final minor:Int; + + /** + libuv patch version number. + **/ + static final patch:Int; + + /** + `true` if the libuv version is a release, and `false` if it is a development version. + This does not depend on Haxe compilation arguments and will almost always be `true`. + **/ + static final isRelease:Bool; + + /** + libuv version suffix for development releases. + **/ + static final suffix:String; + + /** + libuv version packed into a single integer. + **/ + static final hex:Int; +} \ No newline at end of file diff --git a/std/eval/vm/NativeThread.hx b/std/eval/vm/NativeThread.hx index 6640f4a5..43f22172 100644 --- a/std/eval/vm/NativeThread.hx +++ b/std/eval/vm/NativeThread.hx @@ -76,4 +76,7 @@ extern class NativeThread { static function readMessage(block:Bool):T; function sendMessage(msg:T):Void; + + @:allow(sys.thread.Thread) + private var events(get,set):Null; } diff --git a/std/flash/Boot.hx b/std/flash/Boot.hx index 076ca85a..05c2b8b8 100644 --- a/std/flash/Boot.hx +++ b/std/flash/Boot.hx @@ -58,7 +58,7 @@ class Boot extends flash.display.MovieClip { var c = flash.Lib.current; try { untyped if (c == this && c.stage != null && c.stage.align == "") - c.stage.align = "TOP_LEFT"; + c.stage.align = cast "TOP_LEFT"; } catch (e:Dynamic) { // security error when loading from different domain } diff --git a/std/flash/_std/Std.hx b/std/flash/_std/Std.hx index 9609b7fe..869c36bf 100644 --- a/std/flash/_std/Std.hx +++ b/std/flash/_std/Std.hx @@ -23,6 +23,7 @@ import flash.Boot; @:coreApi class Std { + @:deprecated('Std.is is deprecated. Use Std.isOfType instead.') public static inline function is(v:Dynamic, t:Dynamic):Bool { return isOfType(v, t); } diff --git a/std/flash/_std/haxe/Exception.hx b/std/flash/_std/haxe/Exception.hx index 597b7882..3768eafa 100644 --- a/std/flash/_std/haxe/Exception.hx +++ b/std/flash/_std/haxe/Exception.hx @@ -16,7 +16,7 @@ class Exception extends NativeException { @:noCompletion var __previousException:Null; static function caught(value:Any):Exception { - if(Std.is(value, Exception)) { + if(Std.isOfType(value, Exception)) { return value; } else if(Std.isOfType(value, Error)) { return new Exception((value:Error).message, null, value); diff --git a/std/flash/_std/haxe/zip/Compress.hx b/std/flash/_std/haxe/zip/Compress.hx index e706d9cb..5f1ac98d 100644 --- a/std/flash/_std/haxe/zip/Compress.hx +++ b/std/flash/_std/haxe/zip/Compress.hx @@ -25,7 +25,7 @@ package haxe.zip; @:coreApi class Compress { public function new(level:Int):Void { - throw "Not implemented for this platform"; + throw new haxe.exceptions.NotImplementedException("Not implemented for this platform"); } public function execute(src:haxe.io.Bytes, srcPos:Int, dst:haxe.io.Bytes, dstPos:Int):{done:Bool, read:Int, write:Int} { diff --git a/std/flash/_std/haxe/zip/Uncompress.hx b/std/flash/_std/haxe/zip/Uncompress.hx index 4beec601..27ba19be 100644 --- a/std/flash/_std/haxe/zip/Uncompress.hx +++ b/std/flash/_std/haxe/zip/Uncompress.hx @@ -25,7 +25,7 @@ package haxe.zip; @:coreApi class Uncompress { public function new(?windowBits:Int):Void { - throw "Not implemented for this platform"; + throw new haxe.exceptions.NotImplementedException("Not implemented for this platform"); } public function execute(src:haxe.io.Bytes, srcPos:Int, dst:haxe.io.Bytes, dstPos:Int):{done:Bool, read:Int, write:Int} { diff --git a/std/flash/events/KeyboardEvent.hx b/std/flash/events/KeyboardEvent.hx index 1f9129a0..fee77145 100644 --- a/std/flash/events/KeyboardEvent.hx +++ b/std/flash/events/KeyboardEvent.hx @@ -7,7 +7,7 @@ extern class KeyboardEvent extends Event { @:flash.property var keyCode(get,set) : UInt; @:flash.property var keyLocation(get,set) : flash.ui.KeyLocation; @:flash.property var shiftKey(get,set) : Bool; - function new(type : String, bubbles : Bool = true, cancelable : Bool = false, charCodeValue : UInt = 0, keyCodeValue : UInt = 0, keyLocationValue : flash.ui.KeyLocation = 0, ctrlKeyValue : Bool = false, altKeyValue : Bool = false, shiftKeyValue : Bool = false) : Void; + function new(type : String, bubbles : Bool = true, cancelable : Bool = false, charCodeValue : UInt = 0, keyCodeValue : UInt = 0, keyLocationValue : flash.ui.KeyLocation = flash.ui.KeyLocation.D_PAD, ctrlKeyValue : Bool = false, altKeyValue : Bool = false, shiftKeyValue : Bool = false) : Void; private function get_altKey() : Bool; private function get_charCode() : UInt; private function get_ctrlKey() : Bool; diff --git a/std/haxe/CallStack.hx b/std/haxe/CallStack.hx index fbb3d628..e9260b77 100644 --- a/std/haxe/CallStack.hx +++ b/std/haxe/CallStack.hx @@ -28,7 +28,7 @@ package haxe; enum StackItem { CFunction; Module(m:String); - FilePos(s:Null, file:String, line:Int, ?column:Null); + FilePos(s:Null, file:String, line:Int, ?column:Int); Method(classname:Null, method:String); LocalFunction(?v:Int); } @@ -134,7 +134,7 @@ abstract CallStack(Array) from Array { static function exceptionToString(e:Exception):String { if(e.previous == null) { - return 'Exception: ${e.message}${e.stack}'; + return 'Exception: ${e.toString()}${e.stack}'; } var result = ''; var e:Null = e; diff --git a/std/haxe/EntryPoint.hx b/std/haxe/EntryPoint.hx index 9399a3d2..45d9d146 100644 --- a/std/haxe/EntryPoint.hx +++ b/std/haxe/EntryPoint.hx @@ -1,6 +1,6 @@ package haxe; -#if target.threaded +#if (target.threaded && !cppia) import sys.thread.Lock; import sys.thread.Mutex; import sys.thread.Thread; @@ -34,8 +34,15 @@ private class Thread { **/ class EntryPoint { #if sys - static var sleepLock = new Lock(); - static var mutex = new Mutex(); + static var mutex = new Mutex(); + #if (target.threaded && !cppia) + static var mainThread:Thread; + @:keep static function init() { + mainThread = Thread.current(); + } + #else + static var sleepLock = new Lock(); + #end #end static var pending = new ArrayVoid>(); public static var threadCount(default, null):Int = 0; @@ -44,17 +51,21 @@ class EntryPoint { Wakeup a sleeping `run()` **/ public static function wakeup() { - #if sys + #if (sys && !(target.threaded && !cppia)) sleepLock.release(); #end } public static function runInMainThread(f:Void->Void) { #if sys - mutex.acquire(); - pending.push(f); - mutex.release(); - wakeup(); + #if (target.threaded && !cppia) + mainThread.events.run(f); + #else + mutex.acquire(); + pending.push(f); + mutex.release(); + wakeup(); + #end #else pending.push(f); #end @@ -65,6 +76,9 @@ class EntryPoint { mutex.acquire(); threadCount++; mutex.release(); + #if (target.threaded && !cppia) + mainThread.events.promise(); + #end Thread.create(function() { f(); mutex.acquire(); @@ -72,6 +86,9 @@ class EntryPoint { if (threadCount == 0) wakeup(); mutex.release(); + #if (target.threaded && !cppia) + mainThread.events.runPromised(() -> {}); + #end }); #else threadCount++; @@ -83,6 +100,9 @@ class EntryPoint { } static function processEvents():Float { + #if (target.threaded && !cppia) + return -1; + #else // flush all pending calls while (true) { #if sys @@ -100,6 +120,7 @@ class EntryPoint { if (!MainLoop.hasEvents() && threadCount == 0) return -1; return time; + #end } /** @@ -130,6 +151,8 @@ class EntryPoint { #end #elseif flash flash.Lib.current.stage.addEventListener(flash.events.Event.ENTER_FRAME, function(_) processEvents()); + #elseif (target.threaded && !cppia) + //everything is delegated to sys.thread.EventLoop #elseif sys while (true) { var nextTick = processEvents(); diff --git a/std/haxe/Int32.hx b/std/haxe/Int32.hx index da01ff1d..615bea18 100644 --- a/std/haxe/Int32.hx +++ b/std/haxe/Int32.hx @@ -26,6 +26,7 @@ package haxe; Int32 provides a 32-bit integer with consistent overflow behavior across all platforms. **/ +@:transitive abstract Int32(Int) from Int to Int { @:op(-A) private inline function negate():Int32 return clamp(~this + 1); @@ -67,7 +68,7 @@ abstract Int32(Int) from Int to Int { @:op(A - B) private static function subFloat(a:Int32, b:Float):Float; - @:op(A - B) public static function floatSub(a:Float, b:Int32):Float; + @:op(A - B) private static function floatSub(a:Float, b:Int32):Float; #if (js || php || python || lua) #if js diff --git a/std/haxe/Int64.hx b/std/haxe/Int64.hx index 2560ec8e..06c256c4 100644 --- a/std/haxe/Int64.hx +++ b/std/haxe/Int64.hx @@ -31,6 +31,7 @@ using haxe.Int64; #if flash @:notNull #end +@:transitive abstract Int64(__Int64) from __Int64 to __Int64 { private inline function new(x:__Int64) this = x; diff --git a/std/haxe/Log.hx b/std/haxe/Log.hx index 9814dde2..a0f4cd78 100644 --- a/std/haxe/Log.hx +++ b/std/haxe/Log.hx @@ -69,7 +69,7 @@ class Log { #elseif sys Sys.println(str); #else - throw "Not implemented" + throw new haxe.exceptions.NotImplementedException() #end } } diff --git a/std/haxe/MainLoop.hx b/std/haxe/MainLoop.hx index 96a6fa93..1fe0751c 100644 --- a/std/haxe/MainLoop.hx +++ b/std/haxe/MainLoop.hx @@ -1,6 +1,10 @@ package haxe; import haxe.EntryPoint; +#if (target.threaded && !cppia) +import sys.thread.EventLoop; +import sys.thread.Thread; +#end class MainEvent { var f:Void->Void; @@ -56,6 +60,14 @@ class MainEvent { @:access(haxe.MainEvent) class MainLoop { + #if (target.threaded && !cppia) + static var eventLoopHandler:Null; + static var mutex = new sys.thread.Mutex(); + static var mainThread(get,never):Thread; + static inline function get_mainThread():Thread + return @:privateAccess EntryPoint.mainThread; + #end + static var pending:MainEvent; public static var threadCount(get, never):Int; @@ -93,9 +105,29 @@ class MainLoop { head.prev = e; e.next = head; pending = e; + injectIntoEventLoop(0); return e; } + static function injectIntoEventLoop(waitMs:Int) { + #if (target.threaded && !cppia) + mutex.acquire(); + if(eventLoopHandler != null) { + mainThread.events.cancel(eventLoopHandler); + } + eventLoopHandler = mainThread.events.repeat( + () -> { + var wait = tick(); + if(hasEvents()) { + injectIntoEventLoop(Std.int(wait * 1000)); + } + }, + waitMs + ); + mutex.release(); + #end + } + static function sortEvents() { // pending = haxe.ds.ListSort.sort(pending, function(e1, e2) return e1.nextRun > e2.nextRun ? -1 : 1); // we can't use directly ListSort because it requires prev/next to be public, which we don't want here diff --git a/std/haxe/Rest.hx b/std/haxe/Rest.hx new file mode 100644 index 00000000..656ec223 --- /dev/null +++ b/std/haxe/Rest.hx @@ -0,0 +1,91 @@ +package haxe; + +import haxe.iterators.RestIterator; +import haxe.iterators.RestKeyValueIterator; + +private typedef NativeRest = Array; + +/** + A special type that represents a "rest" function argument. + + The special `...` syntax can be used for convenience and improved readability: + + ```haxe + function f(...rest:Int) { + $type(rest); // haxe.Rest + } + + f(1, 2, 3); + + final array = [1, 2, 3]; + f(...array); + ``` + + Should be used as a type for the last argument of a method, indicating that + an arbitrary number of arguments of the given type can be passed to that method. + + Allows to use array access by index to get values of rest arguments. + If the index exceeds the amount of rest arguments passed, the result is unspecified. +**/ +@:coreApi +abstract Rest(NativeRest) { + /** Amount of arguments passed as rest arguments */ + public var length(get,never):Int; + inline function get_length():Int + return this.length; + + /** + Create rest arguments using contents of `array`. + + WARNING: + Depending on a target platform modifying `array` after using this method + may affect the created `Rest` instance. + Use `Rest.of(array.copy())` to avoid that. + **/ + @:from static public inline function of(array:Array):Rest + return new Rest(array); + + inline function new(array:Array):Void + this = array; + + @:arrayAccess inline function get(index:Int):T + return this[index]; + + /** + Creates an array containing all the values of rest arguments. + **/ + @:to public #if !cppia inline #end function toArray():Array + return this.copy(); + + public inline function iterator():RestIterator + return new RestIterator(this); + + public inline function keyValueIterator():RestKeyValueIterator + return new RestKeyValueIterator(this); + + /** + Create a new rest arguments collection by appending `item` to this one. + **/ + public function append(item:T):Rest { + var result = this.copy(); + result.push(item); + return new Rest(result); + } + + /** + Create a new rest arguments collection by prepending this one with `item`. + **/ + public function prepend(item:T):Rest { + var result = this.copy(); + result.unshift(item); + return new Rest(result); + } + + public inline function toString():String { + #if (flash || js) + return '[${this.toString()}]'; + #else + return this.toString(); + #end + } +} \ No newline at end of file diff --git a/std/haxe/Template.hx b/std/haxe/Template.hx index 724626bd..fbeda94c 100644 --- a/std/haxe/Template.hx +++ b/std/haxe/Template.hx @@ -121,11 +121,13 @@ class Template { function resolve(v:String):Dynamic { if (v == "__current__") return context; - var value = Reflect.getProperty(context, v); - if (value != null || Reflect.hasField(context, v)) - return value; + if (Reflect.isObject(context)) { + var value = Reflect.getProperty(context, v); + if (value != null || Reflect.hasField(context, v)) + return value; + } for (ctx in stack) { - value = Reflect.getProperty(ctx, v); + var value = Reflect.getProperty(ctx, v); if (value != null || Reflect.hasField(ctx, v)) return value; } diff --git a/std/haxe/Timer.hx b/std/haxe/Timer.hx index a2cbf053..c641f46d 100644 --- a/std/haxe/Timer.hx +++ b/std/haxe/Timer.hx @@ -22,6 +22,11 @@ package haxe; +#if (target.threaded && !cppia) +import sys.thread.Thread; +import sys.thread.EventLoop; +#end + /** The `Timer` class allows you to create asynchronous timers on platforms that support events. @@ -39,9 +44,9 @@ package haxe; class Timer { #if (flash || js) private var id:Null; - #elseif (java && !jvm) - private var timer:java.util.Timer; - private var task:java.util.TimerTask; + #elseif (target.threaded && !cppia) + var thread:Thread; + var eventHandler:EventHandler; #else private var event:MainLoop.MainEvent; #end @@ -66,9 +71,9 @@ class Timer { #elseif js var me = this; id = untyped setInterval(function() me.run(), time_ms); - #elseif (java && !jvm) - timer = new java.util.Timer(); - timer.scheduleAtFixedRate(task = new TimerTask(this), haxe.Int64.ofInt(time_ms), haxe.Int64.ofInt(time_ms)); + #elseif (target.threaded && !cppia) + thread = Thread.current(); + eventHandler = thread.events.repeat(() -> this.run(), time_ms); #else var dt = time_ms / 1000; event = MainLoop.add(function() { @@ -97,12 +102,8 @@ class Timer { untyped clearInterval(id); #end id = null; - #elseif (java && !jvm) - if (timer != null) { - timer.cancel(); - timer = null; - } - task = null; + #elseif (target.threaded && !cppia) + thread.events.cancel(eventHandler); #else if (event != null) { event.stop(); @@ -189,20 +190,4 @@ class Timer { return 0; #end } -} - -#if (java && !jvm) -@:nativeGen -private class TimerTask extends java.util.TimerTask { - var timer:Timer; - - public function new(timer:Timer):Void { - super(); - this.timer = timer; - } - - @:overload override public function run():Void { - timer.run(); - } -} -#end +} \ No newline at end of file diff --git a/std/haxe/Unserializer.hx b/std/haxe/Unserializer.hx index 8b983c9b..8dbfe7a1 100644 --- a/std/haxe/Unserializer.hx +++ b/std/haxe/Unserializer.hx @@ -22,6 +22,8 @@ package haxe; +using haxe.Unserializer; + import haxe.ds.List; @:noDoc @@ -98,7 +100,7 @@ class Unserializer { **/ public function new(buf:String) { this.buf = buf; - length = buf.length; + length = this.buf.fastLength(); pos = 0; #if neko upos = 0; @@ -137,8 +139,12 @@ class Unserializer { return resolver; } - inline function get(p):Int { + inline function get(p:Int):Int { + #if php + return p >= length ? 0 : buf.fastCharCodeAt(p); + #else return StringTools.fastCodeAt(buf, p); + #end } function readDigits() { @@ -178,7 +184,7 @@ class Unserializer { else break; } - return Std.parseFloat(buf.substr(p1, pos - p1)); + return Std.parseFloat(buf.fastSubstr(p1, pos - p1)); } function unserializeObject(o:{}) { @@ -246,7 +252,7 @@ class Unserializer { var len = readDigits(); if (get(pos++) != ":".code || length - pos < len) throw "Invalid string length"; - var s = buf.substr(pos, len); + var s = buf.fastSubstr(pos, len); pos += len; s = StringTools.urlDecode(s); scache.push(s); @@ -375,7 +381,7 @@ class Unserializer { if (get(pos) >= '0'.code && get(pos) <= '9'.code && get(pos + 1) >= '0'.code && get(pos + 1) <= '9'.code && get(pos + 2) >= '0'.code && get(pos + 2) <= '9'.code && get(pos + 3) >= '0'.code && get(pos + 3) <= '9'.code && get(pos + 4) == '-'.code) { // Included for backwards compatibility - d = Date.fromString(buf.substr(pos, 19)); + d = Date.fromString(buf.fastSubstr(pos, 19)); pos += 19; } else d = Date.fromTime(readFloat()); @@ -387,9 +393,9 @@ class Unserializer { if (get(pos++) != ":".code || length - pos < len) throw "Invalid bytes length"; #if neko - var bytes = haxe.io.Bytes.ofData(base_decode(untyped buf.substr(pos, len).__s, untyped BASE64.__s)); + var bytes = haxe.io.Bytes.ofData(base_decode(untyped buf.fastSubstr(pos, len).__s, untyped BASE64.__s)); #elseif php - var phpEncoded = php.Global.strtr(buf.substr(pos, len), '%:', '+/'); + var phpEncoded = php.Global.strtr(buf.fastSubstr(pos, len), '%:', '+/'); var bytes = haxe.io.Bytes.ofData(php.Global.base64_decode(phpEncoded)); #else var codes = CODES; @@ -451,7 +457,7 @@ class Unserializer { default: } pos--; - throw("Invalid char " + buf.charAt(pos) + " at position " + pos); + throw("Invalid char " + buf.fastCharAt(pos) + " at position " + pos); } /** @@ -468,6 +474,38 @@ class Unserializer { #if neko static var base_decode = neko.Lib.load("std", "base_decode", 2); #end + + static inline function fastLength(s:String):Int { + #if php + return php.Global.strlen(s); + #else + return s.length; + #end + } + + static inline function fastCharCodeAt(s:String, pos:Int):Int { + #if php + return php.Global.ord((s:php.NativeString)[pos]); + #else + return s.charCodeAt(pos); + #end + } + + static inline function fastCharAt(s:String, pos:Int):String { + #if php + return (s:php.NativeString)[pos]; + #else + return s.charAt(pos); + #end + } + + static inline function fastSubstr(s:String, pos:Int, length:Int):String { + #if php + return php.Global.substr(s, pos, length); + #else + return s.substr(pos, length); + #end + } } private class DefaultResolver { diff --git a/std/haxe/Utf8.hx b/std/haxe/Utf8.hx index 9ceee126..81db31b5 100644 --- a/std/haxe/Utf8.hx +++ b/std/haxe/Utf8.hx @@ -63,7 +63,7 @@ class Utf8 { Encode the input ISO string into the corresponding UTF8 one. **/ public static function encode(s:String):String { - throw "Not implemented"; + throw new haxe.exceptions.NotImplementedException(); } /** @@ -71,7 +71,7 @@ class Utf8 { Throw an exception if a given UTF8 character is not supported by the decoder. **/ public static function decode(s:String):String { - throw "Not implemented"; + throw new haxe.exceptions.NotImplementedException(); } /** diff --git a/std/haxe/display/Display.hx b/std/haxe/display/Display.hx index 4ae6aa40..e5acd760 100644 --- a/std/haxe/display/Display.hx +++ b/std/haxe/display/Display.hx @@ -247,6 +247,7 @@ typedef DisplayModuleType = { var doc:JsonDoc; var isExtern:Bool; var isFinal:Bool; + var isAbstract:Bool; var kind:DisplayModuleTypeKind; } @@ -342,6 +343,7 @@ enum abstract KeywordKind(String) to String { var Extern = "extern"; var Dynamic = "dynamic"; var Override = "override"; + var Overload = "overload"; var Class = "class"; var Interface = "interface"; var Enum = "enum"; @@ -412,6 +414,7 @@ typedef FieldCompletionSubject = DisplayItemOccurrence & { typedef ToplevelCompletion = { var ?expectedType:JsonType; var ?expectedTypeFollowed:JsonType; + var ?compatibleTypes:Array>; } typedef StructExtensionCompletion = { @@ -475,10 +478,12 @@ enum abstract FindReferencesKind(String) to String { Does not look for references to parent or overriding methods. **/ var Direct = "direct"; + /** Find references to the base field and all the overidding fields in the inheritance chain. **/ var WithBaseAndDescendants = "withBaseAndDescendants"; + /** Find references to the requested field and references to all descendants of the requested field. @@ -501,6 +506,7 @@ typedef HoverDisplayItemOccurence = DisplayItemOccurrence & { var ?name:{ var name:String; var kind:HoverExpectedNameKind; + var ?doc:String; }; }; } diff --git a/std/haxe/display/JsonModuleTypes.hx b/std/haxe/display/JsonModuleTypes.hx index e55087bf..e546162a 100644 --- a/std/haxe/display/JsonModuleTypes.hx +++ b/std/haxe/display/JsonModuleTypes.hx @@ -250,6 +250,7 @@ typedef JsonClassField = { var type:JsonType; var isPublic:Bool; var isFinal:Bool; + var isAbstract:Bool; var params:JsonTypeParameters; var meta:JsonMetadata; var kind:JsonFieldKind; @@ -288,6 +289,7 @@ enum abstract JsonClassKindKind(String) { var KMacroType; var KAbstractImpl:JsonClassKindKind; var KGenericBuild; + var KModuleFields:JsonClassKindKind; } typedef JsonClassKind = { @@ -300,6 +302,7 @@ typedef JsonClass = { var isInterface:Bool; var isExtern:Bool; var isFinal:Bool; + var isAbstract:Bool; var superClass:Null; var interfaces:Array; var fields:JsonClassFields; diff --git a/std/haxe/ds/Map.hx b/std/haxe/ds/Map.hx index db4e0b5c..344cccf4 100644 --- a/std/haxe/ds/Map.hx +++ b/std/haxe/ds/Map.hx @@ -46,6 +46,7 @@ import haxe.Constraints.IMap; @see https://haxe.org/manual/std-Map.html **/ +@:transitive @:multiType(@:followWithAbstracts K) abstract Map(IMap) { /** diff --git a/std/haxe/ds/ReadOnlyArray.hx b/std/haxe/ds/ReadOnlyArray.hx index b4612267..c1171653 100644 --- a/std/haxe/ds/ReadOnlyArray.hx +++ b/std/haxe/ds/ReadOnlyArray.hx @@ -30,7 +30,7 @@ package haxe.ds; Other code holding a reference to the underlying `Array` can still modify it, and the reference can be obtained with a `cast`. **/ -@:forward(concat, copy, filter, indexOf, iterator, keyValueIterator, join, lastIndexOf, map, slice, contains, toString) +@:forward(copy, filter, indexOf, iterator, keyValueIterator, join, lastIndexOf, map, slice, contains, toString) abstract ReadOnlyArray(Array) from Array to Iterable { /** The length of `this` Array. @@ -42,4 +42,21 @@ abstract ReadOnlyArray(Array) from Array to Iterable { @:arrayAccess inline function get(i:Int) return this[i]; + + /** + Returns a new Array by appending the elements of `a` to the elements of + `this` Array. + + This operation does not modify `this` Array. + + If `a` is the empty Array `[]`, a copy of `this` Array is returned. + + The length of the returned Array is equal to the sum of `this.length` + and `a.length`. + + If `a` is `null`, the result is unspecified. + **/ + public inline function concat(a:ReadOnlyArray):Array { + return this.concat(cast a); + } } diff --git a/std/haxe/ds/Vector.hx b/std/haxe/ds/Vector.hx index 05a4e615..61014e38 100644 --- a/std/haxe/ds/Vector.hx +++ b/std/haxe/ds/Vector.hx @@ -345,7 +345,7 @@ abstract Vector(VectorData) { If `f` is null, the result is unspecified. **/ - public inline function sort(f:T->T->Int):Void { + public inline function sort(f:T->T->Int):Void { #if (neko || cs || java || eval) throw "not yet supported"; #elseif lua diff --git a/std/haxe/ds/WeakMap.hx b/std/haxe/ds/WeakMap.hx index 8b20c480..1d3bf7fb 100644 --- a/std/haxe/ds/WeakMap.hx +++ b/std/haxe/ds/WeakMap.hx @@ -36,7 +36,7 @@ class WeakMap implements haxe.Constraints.IMap { Creates a new WeakMap. **/ public function new():Void { - throw "Not implemented for this platform"; + throw new haxe.exceptions.NotImplementedException("Not implemented for this platform"); } /** diff --git a/std/haxe/exceptions/ArgumentException.hx b/std/haxe/exceptions/ArgumentException.hx new file mode 100644 index 00000000..8bd0fc94 --- /dev/null +++ b/std/haxe/exceptions/ArgumentException.hx @@ -0,0 +1,16 @@ +package haxe.exceptions; + +/** + An exception that is thrown when an invalid value provided for an argument of a function. +**/ +class ArgumentException extends PosException { + /** + An argument name. + **/ + public final argument:String; + + public function new(argument:String, ?message:String, ?previous:Exception, ?pos:PosInfos):Void { + super(message == null ? 'Invalid argument "$argument"' : message, previous, pos); + this.argument = argument; + } +} \ No newline at end of file diff --git a/std/haxe/exceptions/NotImplementedException.hx b/std/haxe/exceptions/NotImplementedException.hx new file mode 100644 index 00000000..22ad9d01 --- /dev/null +++ b/std/haxe/exceptions/NotImplementedException.hx @@ -0,0 +1,10 @@ +package haxe.exceptions; + +/** + An exception that is thrown when requested function or operation does not have an implementation. +**/ +class NotImplementedException extends PosException { + public function new(message:String = 'Not implemented', ?previous:Exception, ?pos:PosInfos):Void { + super(message, previous, pos); + } +} \ No newline at end of file diff --git a/std/haxe/exceptions/PosException.hx b/std/haxe/exceptions/PosException.hx new file mode 100644 index 00000000..2b2af5a3 --- /dev/null +++ b/std/haxe/exceptions/PosException.hx @@ -0,0 +1,27 @@ +package haxe.exceptions; + +/** + An exception that carry position information of a place where it was created. +**/ +class PosException extends Exception { + /** + Position where this exception was created. + **/ + public final posInfos:PosInfos; + + public function new(message:String, ?previous:Exception, ?pos:PosInfos):Void { + super(message, previous); + if (pos == null) { + posInfos = { fileName:'(unknown)', lineNumber:0, className:'(unknown)', methodName:'(unknown)' } + } else { + posInfos = pos; + } + } + + /** + Returns exception message. + **/ + override function toString():String { + return '${super.toString()} in ${posInfos.className}.${posInfos.methodName} at ${posInfos.fileName}:${posInfos.lineNumber}'; + } +} \ No newline at end of file diff --git a/std/haxe/extern/AsVar.hx b/std/haxe/extern/AsVar.hx index c4990764..9c25419d 100644 --- a/std/haxe/extern/AsVar.hx +++ b/std/haxe/extern/AsVar.hx @@ -27,5 +27,6 @@ package haxe.extern; argument expressions are bound to a local variable. **/ @:forward +@:transitive @:semantics(variable) abstract AsVar(T) from T to T {} diff --git a/std/haxe/extern/EitherType.hx b/std/haxe/extern/EitherType.hx index 5b57b77f..1e87e1c4 100644 --- a/std/haxe/extern/EitherType.hx +++ b/std/haxe/extern/EitherType.hx @@ -33,4 +33,5 @@ package haxe.extern; @see **/ +@:transitive abstract EitherType(Dynamic) from T1 to T1 from T2 to T2 {} diff --git a/std/haxe/extern/Rest.hx b/std/haxe/extern/Rest.hx index 2aba9b22..5ada5332 100644 --- a/std/haxe/extern/Rest.hx +++ b/std/haxe/extern/Rest.hx @@ -23,12 +23,12 @@ package haxe.extern; /** - A special abstract type that represents "rest" function argument. - + DEPRECATED: use haxe.Rest instead. + + A special type that represents "rest" function argument. Should be used as a type for the last argument of an extern method, representing that arbitrary number of arguments of given type can be passed to that method. - @see **/ -abstract Rest(Array) {} +typedef Rest = haxe.Rest diff --git a/std/haxe/format/JsonParser.hx b/std/haxe/format/JsonParser.hx index e01b5c7c..188719ac 100644 --- a/std/haxe/format/JsonParser.hx +++ b/std/haxe/format/JsonParser.hx @@ -301,8 +301,12 @@ class JsonParser { } var f = Std.parseFloat(str.substr(start, pos - start)); - var i = Std.int(f); - return if (i == f) i else f; + if(point) { + return f; + } else { + var i = Std.int(f); + return if (i == f) i else f; + } } inline function nextChar() { diff --git a/std/haxe/format/JsonPrinter.hx b/std/haxe/format/JsonPrinter.hx index f0471164..e7536328 100644 --- a/std/haxe/format/JsonPrinter.hx +++ b/std/haxe/format/JsonPrinter.hx @@ -202,13 +202,12 @@ class JsonPrinter { #end addChar('"'.code); var i = 0; + var length = s.length; #if hl var prev = -1; #end - while (true) { - var c = StringTools.fastCodeAt(s, i++); - if (StringTools.isEof(c)) - break; + while (i < length) { + var c = StringTools.unsafeCodeAt(s, i++); switch (c) { case '"'.code: add('\\"'); diff --git a/std/haxe/http/HttpBase.hx b/std/haxe/http/HttpBase.hx index ce357cfd..ac3bcdad 100644 --- a/std/haxe/http/HttpBase.hx +++ b/std/haxe/http/HttpBase.hx @@ -34,7 +34,7 @@ private typedef StringKeyValue = { platforms. There are two intended usages: - call `haxe.Http.requestUrl(url)` and receive the result as a `String` - (not available on flash) + (only available on `sys` targets) - create a `new haxe.Http(url)`, register your callbacks for `onData`, `onError` and `onStatus`, then call `request()`. **/ @@ -76,9 +76,9 @@ class HttpBase { } /** - Sets the header identified as `header` to value `value`. + Sets the header identified as `name` to value `value`. - If `header` or `value` are null, the result is unspecified. + If `name` or `value` are null, the result is unspecified. This method provides a fluent interface. **/ @@ -103,9 +103,9 @@ class HttpBase { } /** - Sets the parameter identified as `param` to value `value`. + Sets the parameter identified as `name` to value `value`. - If `header` or `value` are null, the result is unspecified. + If `name` or `value` are null, the result is unspecified. This method provides a fluent interface. **/ @@ -183,7 +183,7 @@ class HttpBase { this method returns. **/ public function request(?post:Bool):Void { - throw "not implemented"; + throw new haxe.exceptions.NotImplementedException(); } /** diff --git a/std/haxe/http/HttpNodeJs.hx b/std/haxe/http/HttpNodeJs.hx index 50e0d45c..cfb305ef 100644 --- a/std/haxe/http/HttpNodeJs.hx +++ b/std/haxe/http/HttpNodeJs.hx @@ -47,10 +47,10 @@ class HttpNodeJs extends haxe.http.HttpBase { public override function request(?post:Bool) { responseAsString = null; responseBytes = null; - var parsedUrl = js.node.Url.parse(url); + var parsedUrl = new js.node.url.URL(url); var secure = (parsedUrl.protocol == "https:"); var host = parsedUrl.hostname; - var path = parsedUrl.path; + var path = parsedUrl.pathname; var port = if (parsedUrl.port != null) Std.parseInt(parsedUrl.port) else (secure ? 443 : 80); var h:Dynamic = {}; for (i in headers) { diff --git a/std/haxe/io/Float64Array.hx b/std/haxe/io/Float64Array.hx index 7221883c..7ac9bbaa 100644 --- a/std/haxe/io/Float64Array.hx +++ b/std/haxe/io/Float64Array.hx @@ -43,12 +43,12 @@ abstract Float64Array(Float64ArrayData) { } @:arrayAccess public inline function get(index:Int):Float { - return this.bytes.getFloat((index << 3) + this.byteOffset); + return this.bytes.getDouble((index << 3) + this.byteOffset); } @:arrayAccess public inline function set(index:Int, value:Float):Float { if (index >= 0 && index < length) { - this.bytes.setFloat((index << 3) + this.byteOffset, value); + this.bytes.setDouble((index << 3) + this.byteOffset, value); return value; } return 0; diff --git a/std/haxe/io/Input.hx b/std/haxe/io/Input.hx index ccc09fb1..06bb6d0d 100644 --- a/std/haxe/io/Input.hx +++ b/std/haxe/io/Input.hx @@ -48,9 +48,9 @@ class Input { **/ public function readByte():Int { #if cpp - throw "Not implemented"; + throw new haxe.exceptions.NotImplementedException(); #else - return throw "Not implemented"; + return throw new haxe.exceptions.NotImplementedException(); #end } diff --git a/std/haxe/io/Output.hx b/std/haxe/io/Output.hx index b6ea6351..b8eb1e4f 100644 --- a/std/haxe/io/Output.hx +++ b/std/haxe/io/Output.hx @@ -44,7 +44,7 @@ class Output { Write one byte. **/ public function writeByte(c:Int):Void { - throw "Not implemented"; + throw new haxe.exceptions.NotImplementedException(); } /** diff --git a/std/haxe/iterators/MapKeyValueIterator.hx b/std/haxe/iterators/MapKeyValueIterator.hx index fa9b7c47..fa051cda 100644 --- a/std/haxe/iterators/MapKeyValueIterator.hx +++ b/std/haxe/iterators/MapKeyValueIterator.hx @@ -49,6 +49,6 @@ class MapKeyValueIterator { **/ public inline function next():{key:K, value:V} { var key = keys.next(); - return {value: map.get(key), key: key}; + return {value: @:nullSafety(Off) (map.get(key) : V), key: key}; } } diff --git a/std/haxe/iterators/RestIterator.hx b/std/haxe/iterators/RestIterator.hx new file mode 100644 index 00000000..eba87d79 --- /dev/null +++ b/std/haxe/iterators/RestIterator.hx @@ -0,0 +1,19 @@ +package haxe.iterators; + +class RestIterator { + final args:Rest; + var current:Int = 0; + + @:allow(haxe.Rest) + inline function new(args:Any) { + this.args = args; + } + + public inline function hasNext():Bool { + return current < args.length; + } + + public inline function next():T { + return args[current++]; + } +} \ No newline at end of file diff --git a/std/haxe/iterators/RestKeyValueIterator.hx b/std/haxe/iterators/RestKeyValueIterator.hx new file mode 100644 index 00000000..ff287eea --- /dev/null +++ b/std/haxe/iterators/RestKeyValueIterator.hx @@ -0,0 +1,19 @@ +package haxe.iterators; + +class RestKeyValueIterator { + final args:Rest; + var current:Int = 0; + + @:allow(haxe.Rest) + inline function new(args:Any) { + this.args = args; + } + + public inline function hasNext():Bool { + return current < args.length; + } + + public inline function next():{key:Int, value:T} { + return {key:current, value:args[current++]}; + } +} \ No newline at end of file diff --git a/std/haxe/iterators/StringIterator.hx b/std/haxe/iterators/StringIterator.hx index 46d3a421..63b69292 100644 --- a/std/haxe/iterators/StringIterator.hx +++ b/std/haxe/iterators/StringIterator.hx @@ -23,33 +23,33 @@ package haxe.iterators; /** - This iterator can be used to iterate over char codes in a string. + This iterator can be used to iterate over char codes in a string. - Note that char codes may differ across platforms because of different - internal encoding of strings in different of runtimes. - **/ + Note that char codes may differ across platforms because of different + internal encoding of strings in different of runtimes. +**/ class StringIterator { - var offset = 0; - var s:String; + var offset = 0; + var s:String; - /** - Create a new `StringIterator` over String `s`. - **/ - public inline function new(s:String) { - this.s = s; - } + /** + Create a new `StringIterator` over String `s`. + **/ + public inline function new(s:String) { + this.s = s; + } - /** - See `Iterator.hasNext` - **/ - public inline function hasNext() { - return offset < s.length; - } + /** + See `Iterator.hasNext` + **/ + public inline function hasNext() { + return offset < s.length; + } - /** - See `Iterator.next` - **/ - public inline function next() { - return StringTools.fastCodeAt(s, offset++); - } + /** + See `Iterator.next` + **/ + public inline function next() { + return StringTools.unsafeCodeAt(s, offset++); + } } diff --git a/std/haxe/iterators/StringIteratorUnicode.hx b/std/haxe/iterators/StringIteratorUnicode.hx index ca73609c..4a73d83d 100644 --- a/std/haxe/iterators/StringIteratorUnicode.hx +++ b/std/haxe/iterators/StringIteratorUnicode.hx @@ -60,7 +60,7 @@ class StringIteratorUnicode { } return c; #else - return StringTools.fastCodeAt(s, offset++); + return StringTools.unsafeCodeAt(s, offset++); #end } diff --git a/std/haxe/macro/Compiler.hx b/std/haxe/macro/Compiler.hx index 52b6a14a..2b6d7003 100644 --- a/std/haxe/macro/Compiler.hx +++ b/std/haxe/macro/Compiler.hx @@ -192,6 +192,7 @@ class Compiler { If you want to specify a different set of paths to search for modules, you can use the optional argument `classPath`. + @param pack The package dot-path as String. Use `''` to include the root package. @param rec If true, recursively adds all sub-packages. @param ignore Array of module names to ignore for inclusion. You can use `module*` with a * at the end for Wildcard matching @@ -282,6 +283,7 @@ class Compiler { Exclude a specific class, enum, or all classes and enums in a package from being generated. Excluded types become `extern`. + @param pack The package dot-path as String. Use `''` to exclude the root package. @param rec If true, recursively excludes all sub-packages. **/ public static function exclude(pack:String, ?rec = true) { diff --git a/std/haxe/macro/Expr.hx b/std/haxe/macro/Expr.hx index bb15ac30..cd66f6f0 100644 --- a/std/haxe/macro/Expr.hx +++ b/std/haxe/macro/Expr.hx @@ -245,6 +245,11 @@ enum Unop { `~` **/ OpNegBits; + + /** + `...` + **/ + OpSpread; } /** @@ -283,12 +288,12 @@ typedef Case = { /** The optional guard expressions of the case, if available. **/ - var ?guard:Null; + var ?guard:Expr; /** The expression of the case, if available. **/ - var expr:Null; + var ?expr:Expr; } /** @@ -304,17 +309,22 @@ typedef Var = { /** The type-hint of the variable, if available. **/ - var type:Null; + var ?type:ComplexType; /** The expression of the variable, if available. **/ - var expr:Null; + var ?expr:Expr; /** Whether or not the variable can be assigned to. **/ var ?isFinal:Bool; + + /** + Metadata associatied with the variable, if available. + **/ + var ?meta:Metadata; } /** @@ -503,7 +513,7 @@ enum ExprDef { /** A `return` or `return e` expression. **/ - EReturn(?e:Null); + EReturn(?e:Expr); /** A `break` expression. @@ -554,6 +564,11 @@ enum ExprDef { A `@m e` expression. **/ EMeta(s:MetadataEntry, e:Expr); + + /** + An `expr is Type` expression. + **/ + EIs(e:Expr, t:ComplexType); } enum DisplayKind { @@ -637,7 +652,7 @@ typedef TypePath = { Sub is set on module sub-type access: `pack.Module.Type` has `name = "Module"`, `sub = "Type"`, if available. **/ - var ?sub:Null; + var ?sub:String; } /** @@ -689,12 +704,12 @@ typedef Function = { /** The return type-hint of the function, if available. **/ - var ret:Null; + var ?ret:ComplexType; /** The expression of the function body, if available. **/ - var expr:Null; + var ?expr:Expr; /** An optional list of function parameter type declarations. @@ -719,12 +734,12 @@ typedef FunctionArg = { /** The type-hint of the function argument, if available. **/ - var type:Null; + var ?type:ComplexType; /** The optional value of the function argument, if available. **/ - var ?value:Null; + var ?value:Expr; /** The metadata of the function argument. @@ -770,7 +785,7 @@ typedef Field = { The documentation of the field, if available. If the field has no documentation, the value is `null`. **/ - var ?doc:Null; + var ?doc:String; /** The access modifiers of the field. By default fields have private access. @@ -852,6 +867,16 @@ enum Access { Extern access modifier. **/ AExtern; + + /** + Abstract access modifier. + **/ + AAbstract; + + /** + Overload access modifier. + **/ + AOverload; } /** @@ -861,7 +886,7 @@ enum FieldType { /** Represents a variable field type. **/ - FVar(t:Null, ?e:Null); + FVar(t:Null, ?e:Expr); /** Represents a function field type. @@ -871,7 +896,7 @@ enum FieldType { /** Represents a property with getter and setter field type. **/ - FProp(get:String, set:String, ?t:Null, ?e:Null); + FProp(get:String, set:String, ?t:ComplexType, ?e:Expr); } /** @@ -892,7 +917,7 @@ typedef TypeDefinition = { The documentation of the type, if available. If the type has no documentation, the value is `null`. **/ - var ?doc:Null; + var ?doc:String; /** The position to the type definition. @@ -942,7 +967,7 @@ enum TypeDefKind { /** Represents a class kind. **/ - TDClass(?superClass:TypePath, ?interfaces:Array, ?isInterface:Bool, ?isFinal:Bool); + TDClass(?superClass:TypePath, ?interfaces:Array, ?isInterface:Bool, ?isFinal:Bool, ?isAbstract:Bool); /** Represents an alias/typedef kind. @@ -953,6 +978,11 @@ enum TypeDefKind { Represents an abstract kind. **/ TDAbstract(tthis:Null, ?from:Array, ?to:Array); + + /** + Represents a module-level field. + **/ + TDField(kind:FieldType, ?access:Array); // ignore TypeDefinition.fields } /** diff --git a/std/haxe/macro/ExprTools.hx b/std/haxe/macro/ExprTools.hx index 747e6077..edce5d42 100644 --- a/std/haxe/macro/ExprTools.hx +++ b/std/haxe/macro/ExprTools.hx @@ -71,7 +71,7 @@ class ExprTools { static public function iter(e:Expr, f:Expr->Void):Void { switch (e.expr) { case EConst(_), EContinue, EBreak, EDisplayNew(_): - case EField(e, _), EParenthesis(e), EUntyped(e), EThrow(e), EDisplay(e, _), ECheckType(e, _), EUnop(_, _, e), ECast(e, _), EMeta(_, e): + case EField(e, _), EParenthesis(e), EUntyped(e), EThrow(e), EDisplay(e, _), ECheckType(e, _), EUnop(_, _, e), ECast(e, _), EIs(e, _) | EMeta(_, e): f(e); case EArray(e1, e2), EWhile(e1, e2, _), EBinop(_, e1, e2), EFor(e1, e2): f(e1); @@ -172,6 +172,7 @@ class ExprTools { case EUntyped(e): EUntyped(f(e)); case EThrow(e): EThrow(f(e)); case ECast(e, t): ECast(f(e), t); + case EIs(e, t): EIs(f(e), t); case EDisplay(e, dk): EDisplay(f(e), dk); case ETernary(econd, eif, eelse): ETernary(f(econd), f(eif), f(eelse)); case ECheckType(e, t): ECheckType(f(e), t); diff --git a/std/haxe/macro/MacroStringTools.hx b/std/haxe/macro/MacroStringTools.hx index e7fc1005..83044a07 100644 --- a/std/haxe/macro/MacroStringTools.hx +++ b/std/haxe/macro/MacroStringTools.hx @@ -48,26 +48,10 @@ class MacroStringTools { /** Tells if `e` is a format string, i.e. uses single quotes `'` as delimiters. - - This only works if `e` has a position which the compiler can find. While - this is true for any expressions appearing in real Haxe code (i.e. some - .hx file), it might not work for expressions generated by macros. - - This operation depends on the position of `e`. **/ static public function isFormatExpr(e:ExprOf):Bool { - #if (neko || eval) - return Context.load("is_fmt_string", 1)(e.pos); - #else - return isFmtString(e.pos); - #end + return e.expr.match(EConst(CString(_, SingleQuotes))); } - - #if !neko - static function isFmtString(p:Position):Bool { - return false; - } - #end #end /** diff --git a/std/haxe/macro/Printer.hx b/std/haxe/macro/Printer.hx index 382a37ce..31282a97 100644 --- a/std/haxe/macro/Printer.hx +++ b/std/haxe/macro/Printer.hx @@ -47,6 +47,7 @@ class Printer { case OpNot: "!"; case OpNeg: "-"; case OpNegBits: "~"; + case OpSpread: "..."; } public function printBinop(op:Binop) @@ -97,7 +98,8 @@ class Printer { public function printConstant(c:Constant) return switch (c) { - case CString(s): printString(s); + case CString(s, SingleQuotes): printFormatString(s); + case CString(s, _): printString(s); case CIdent(s), CInt(s), CFloat(s): s; case CRegexp(s, opt): '~/$s/$opt'; @@ -137,7 +139,10 @@ class Printer { case TParent(ct): "(" + printComplexType(ct) + ")"; case TOptional(ct): "?" + printComplexType(ct); case TNamed(n, ct): n + ":" + printComplexType(ct); - case TExtend(tpl, fields): '{> ${tpl.map(printTypePath).join(" >, ")}, ${fields.map(printField).join(", ")} }'; + case TExtend(tpl, fields): + var types = [for (t in tpl) "> " + printTypePath(t) + ", "].join(""); + var fields = [for (f in fields) printField(f) + "; "].join(""); + '{${types}${fields}}'; case TIntersection(tl): tl.map(printComplexType).join(" & "); } @@ -155,6 +160,8 @@ class Printer { case AMacro: "macro"; case AFinal: "final"; case AExtern: "extern"; + case AAbstract: "abstract"; + case AOverload: "overload"; } public function printField(field:Field) { @@ -182,7 +189,8 @@ class Printer { } public function printTypeParamDecl(tpd:TypeParamDecl) - return tpd.name + return (tpd.meta != null && tpd.meta.length > 0 ? tpd.meta.map(printMetadata).join(" ") + " " : "") + + tpd.name + (tpd.params != null && tpd.params.length > 0 ? "<" + tpd.params.map(printTypeParamDecl).join(", ") + ">" : "") + (tpd.constraints != null && tpd.constraints.length > 0 ? ":(" + tpd.constraints.map(printComplexType).join(", ") + ")" : ""); @@ -203,8 +211,13 @@ class Printer { + opt(func.expr, printExpr, " "); } - public function printVar(v:Var) - return v.name + opt(v.type, printComplexType, ":") + opt(v.expr, printExpr, " = "); + public function printVar(v:Var) { + var s = v.name + opt(v.type, printComplexType, ":") + opt(v.expr, printExpr, " = "); + return switch v.meta { + case null|[]: s; + case meta: meta.map(printMetadata).join(" ") + " " + s; + } + } public function printObjectFieldKey(of:ObjectField) { return switch (of.quotes) { @@ -219,9 +232,6 @@ class Printer { public function printExpr(e:Expr) return e == null ? "#NULL" : switch (e.expr) { - #if macro - case EConst(CString(s)): haxe.macro.MacroStringTools.isFormatExpr(e) ? printFormatString(s) : printString(s); - #end case EConst(c): printConstant(c); case EArray(e1, e2): '${printExpr(e1)}[${printExpr(e2)}]'; case EBinop(op, e1, e2): '${printExpr(e1)} ${printBinop(op)} ${printExpr(e2)}'; @@ -269,6 +279,7 @@ class Printer { case EThrow(e1): "throw " + printExpr(e1); case ECast(e1, cto) if (cto != null): 'cast(${printExpr(e1)}, ${printComplexType(cto)})'; case ECast(e1, _): "cast " + printExpr(e1); + case EIs(e1, ct): '${printExpr(e1)} is ${printComplexType(ct)}'; case EDisplay(e1, _): '#DISPLAY(${printExpr(e1)})'; case EDisplayNew(tp): '#DISPLAY(${printTypePath(tp)})'; case ETernary(econd, eif, eelse): '${printExpr(econd)} ? ${printExpr(eif)} : ${printExpr(eelse)}'; @@ -337,8 +348,9 @@ class Printer { } ].join("\n") + "\n}"; - case TDClass(superClass, interfaces, isInterface, isFinal): + case TDClass(superClass, interfaces, isInterface, isFinal, isAbstract): (isFinal ? "final " : "") + + (isAbstract ? "abstract " : "") + (isInterface ? "interface " : "class ") + t.name + (t.params != null && t.params.length > 0 ? "<" + t.params.map(printTypeParamDecl).join(", ") + ">" : "") @@ -379,6 +391,14 @@ class Printer { } ].join("\n") + "\n}"; + case TDField(kind, access): + tabs = old; + (access != null && access.length > 0 ? access.map(printAccess).join(" ") + " " : "") + + switch (kind) { + case FVar(type, eo): ((access != null && access.has(AFinal)) ? '' : 'var ') + '${t.name}' + opt(type, printComplexType, " : ") + opt(eo, printExpr, " = ") + ";"; + case FProp(get, set, type, eo): 'var ${t.name}($get, $set)' + opt(type, printComplexType, " : ") + opt(eo, printExpr, " = ") + ";"; + case FFun(func): 'function ${t.name}' + printFunction(func) + switch func.expr { case {expr: EBlock(_)}: ""; case _: ";"; }; + } } tabs = old; return str; @@ -517,6 +537,9 @@ class Printer { case ECast(e, t): add("ECast"); loopI(e); + case EIs(e, t): + add("EIs"); + loopI(e); case EDisplay(e, displayKind): add("EDisplay"); loopI(e); diff --git a/std/haxe/macro/Type.hx b/std/haxe/macro/Type.hx index 85e4f9cc..f55cf81a 100644 --- a/std/haxe/macro/Type.hx +++ b/std/haxe/macro/Type.hx @@ -211,6 +211,11 @@ typedef ClassField = { **/ var isFinal:Bool; + /** + Whether or not the class field is abstract. + **/ + var isAbstract:Bool; + /** The type parameters of the class field. **/ @@ -303,11 +308,9 @@ enum ClassKind { KTypeParameter(constraints:Array); /** - A structurally extended class. - - @deprecated + A class containing module fields. **/ - KExtension(cl:Ref, params:Array); + KModuleFields(module:String); /** A special kind of class to encode expressions into type parameters. @@ -419,6 +422,11 @@ typedef ClassType = BaseType & { **/ var isFinal:Bool; + /** + If true the class is abstract and cannot be instantiated directly. + **/ + var isAbstract:Bool; + /** The parent class and its type parameters, if available. **/ diff --git a/std/haxe/xml/Parser.hx b/std/haxe/xml/Parser.hx index f02765cc..c5e5d01c 100644 --- a/std/haxe/xml/Parser.hx +++ b/std/haxe/xml/Parser.hx @@ -126,7 +126,6 @@ class Parser { var start = 0; var nsubs = 0; var nbrackets = 0; - var c = str.fastCodeAt(p); var buf = new StringBuf(); // need extra state because next is in use var escapeNext = S.BEGIN; @@ -135,7 +134,8 @@ class Parser { parent.addChild(xml); nsubs++; } - while (!StringTools.isEof(c)) { + while (p < str.length) { + var c = str.unsafeCodeAt(p); switch (state) { case S.IGNORE_SPACES: switch (c) { @@ -191,9 +191,8 @@ class Parser { p += 8; state = S.DOCTYPE; start = p + 1; - } else if (str.fastCodeAt(p + 1) != '-'.code || str.fastCodeAt(p + 2) != '-'.code) - throw new XmlParserException("Expected